Session MFODL_Monitor_Optimized

Theory Code_Double

(*<*)
theory Code_Double
  imports IEEE_Floating_Point.IEEE_Properties
    "HOL-Library.Code_Target_Int"
    Containers.Collection_Eq
    Containers.Collection_Order
begin
(*>*)

section ‹Code adaptation for IEEE double-precision floats›

subsection ‹copysign›

lift_definition copysign :: "('e, 'f) float  ('e, 'f) float  ('e, 'f) float" is
  "λ(_, e::'e word, f::'f word) (s::1 word, _, _). (s, e, f)" .

lemma is_nan_copysign[simp]: "is_nan (copysign x y)  is_nan x"
  unfolding is_nan_def by transfer auto


subsection ‹Additional lemmas about generic floats›

lemma is_nan_some_nan[simp]: "is_nan (some_nan :: ('e, 'f) float)"
  unfolding some_nan_def
  by (rule someI[where x="Abs_float (0, max_word :: 'e word, 1)"])
    (auto simp add: is_nan_def exponent_def fraction_def emax_def Abs_float_inverse[simplified])

lemma not_is_nan_0[simp]: "¬ is_nan 0"
  unfolding is_nan_def by (simp add: zero_simps)

lemma not_is_nan_1[simp]: "¬ is_nan 1"
  unfolding is_nan_def by transfer simp

lemma is_nan_plus: "is_nan x  is_nan y  is_nan (x + y)"
  unfolding plus_float_def fadd_def by auto

lemma is_nan_minus: "is_nan x  is_nan y  is_nan (x - y)"
  unfolding minus_float_def fsub_def by auto

lemma is_nan_times: "is_nan x  is_nan y  is_nan (x * y)"
  unfolding times_float_def fmul_def by auto

lemma is_nan_divide: "is_nan x  is_nan y  is_nan (x / y)"
  unfolding divide_float_def fdiv_def by auto

lemma is_nan_float_sqrt: "is_nan x  is_nan (float_sqrt x)"
  unfolding float_sqrt_def fsqrt_def by simp

lemma nan_fcompare: "is_nan x  is_nan y  fcompare x y = Und"
  unfolding fcompare_def by simp

lemma nan_not_le: "is_nan x  is_nan y  ¬ x  y"
  unfolding less_eq_float_def fle_def fcompare_def by simp

lemma nan_not_less: "is_nan x  is_nan y  ¬ x < y"
  unfolding less_float_def flt_def fcompare_def by simp

lemma nan_not_zero: "is_nan x  ¬ is_zero x"
  unfolding is_nan_def is_zero_def by simp

lemma nan_not_infinity: "is_nan x  ¬ is_infinity x"
  unfolding is_nan_def is_infinity_def by simp

lemma zero_not_infinity: "is_zero x  ¬ is_infinity x"
  unfolding is_zero_def is_infinity_def by simp

lemma zero_not_nan: "is_zero x  ¬ is_nan x"
  unfolding is_zero_def is_nan_def by simp


lemma minus_one_power_one_word: "(-1 :: real) ^ unat (x :: 1 word) = (if unat x = 0 then 1 else -1)"
proof -
  have "unat x = 0  unat x = 1"
    using le_SucE[OF unat_one_word_le] by auto
  then show ?thesis by auto
qed

definition valofn :: "('e, 'f) float  real" where
  "valofn x = (2^exponent x / 2^bias TYPE(('e, 'f) float)) *
      (1 + real (fraction x) / 2^LENGTH('f))"

definition valofd :: "('e, 'f) float  real" where
  "valofd x = (2 / 2^bias TYPE(('e, 'f) float)) * (real (fraction x) / 2^LENGTH('f))"

lemma valof_alt: "valof x = (if exponent x = 0 then
    if sign x = 0 then valofd x else - valofd x
  else if sign x = 0 then valofn x else - valofn x)"
  unfolding valofn_def valofd_def
  by transfer (auto simp: minus_one_power_one_word unat_eq_0 field_simps)

lemma fraction_less_2p: "fraction (x :: ('e, 'f) float) < 2^LENGTH('f)"
  by transfer auto

lemma valofn_ge_0: "0  valofn x"
  unfolding valofn_def by simp

lemma valofn_ge_2p: "2^exponent (x :: ('e, 'f) float) / 2^bias TYPE(('e, 'f) float)  valofn x"
  unfolding valofn_def by (simp add: field_simps)

lemma valofn_less_2p:
  fixes x :: "('e, 'f) float"
  assumes "exponent x < e"
  shows "valofn x < 2^e / 2^bias TYPE(('e, 'f) float)"
proof -
  have "1 + real (fraction x) / 2^LENGTH('f) < 2"
    by (simp add: fraction_less_2p)
  then have "valofn x < (2^exponent x / 2^bias TYPE(('e, 'f) float)) * 2"
    unfolding valofn_def by (simp add: field_simps)
  also have "...  2^e / 2^bias TYPE(('e, 'f) float)"
    using assms by (auto simp: less_eq_Suc_le field_simps elim: order_trans[rotated, OF exp_less])
  finally show ?thesis .
qed

lemma valofd_ge_0: "0  valofd x"
  unfolding valofd_def by simp

lemma valofd_less_2p: "valofd (x :: ('e, 'f) float) < 2 / 2^bias TYPE(('e, 'f) float)"
  unfolding valofd_def
  by (simp add: fraction_less_2p field_simps)

lemma valofn_le_imp_exponent_le:
  fixes x y :: "('e, 'f) float"
  assumes "valofn x  valofn y"
  shows "exponent x  exponent y"
proof (rule ccontr)
  assume "¬ exponent x  exponent y"
  then have "valofn y < 2^exponent x / 2^bias TYPE(('e, 'f) float)"
    using valofn_less_2p[of y] by auto
  also have "...  valofn x" by (rule valofn_ge_2p)
  finally show False using assms by simp
qed

lemma valofn_eq:
  fixes x y :: "('e, 'f) float"
  assumes "valofn x = valofn y"
  shows "exponent x = exponent y" "fraction x = fraction y"
proof -
  from assms show "exponent x = exponent y"
    by (auto intro!: antisym valofn_le_imp_exponent_le)
  with assms show "fraction x = fraction y"
    unfolding valofn_def by (simp add: field_simps)
qed

lemma valofd_eq:
  fixes x y :: "('e, 'f) float"
  assumes "valofd x = valofd y"
  shows "fraction x = fraction y"
  using assms unfolding valofd_def by (simp add: field_simps)

lemma is_zero_valof_conv: "is_zero x  valof x = 0"
  unfolding is_zero_def valof_alt
  using valofn_ge_2p[of x] by (auto simp: valofd_def field_simps dest: order.antisym)

lemma valofd_neq_valofn:
  fixes x y :: "('e, 'f) float"
  assumes "exponent y  0"
  shows "valofd x  valofn y" "valofn y  valofd x"
proof -
  have "valofd x < 2 / 2^bias TYPE(('e, 'f) float)" by (rule valofd_less_2p)
  also have "...  2 ^ IEEE.exponent y / 2 ^ bias TYPE(('e, 'f) IEEE.float)"
    using assms by (simp add: self_le_power field_simps)
  also have "...  valofn y" by (rule valofn_ge_2p)
  finally show "valofd x  valofn y" "valofn y  valofd x" by simp_all
qed

lemma sign_gt_0_conv: "0 < sign x  sign x = 1"
  by (cases x rule: sign_cases) simp_all

lemma valof_eq:
  assumes "¬ is_zero x  ¬ is_zero y"
  shows "valof x = valof y  x = y"
proof
  assume *: "valof x = valof y"
  with assms have "valof y  0" by (simp add: is_zero_valof_conv)
  with * show "x = y"
    unfolding valof_alt
    using valofd_ge_0[of x] valofd_ge_0[of y] valofn_ge_0[of x] valofn_ge_0[of y]
    by (auto simp: valofd_neq_valofn sign_gt_0_conv split: if_splits
        intro!: float_eqI elim: valofn_eq valofd_eq)
qed simp

lemma zero_fcompare: "is_zero x  is_zero y  fcompare x y = ccode.Eq"
  unfolding fcompare_def by (simp add: zero_not_infinity zero_not_nan is_zero_valof_conv)


subsection ‹Doubles with a unified NaN value›

quotient_type double = "(11, 52) float" / "λx y. is_nan x  is_nan y  x = y"
  by (auto intro!: equivpI reflpI sympI transpI)

instantiation double :: "{zero, one, plus, minus, uminus, times, ord}"
begin

lift_definition zero_double :: "double" is "0" .
lift_definition one_double :: "double" is "1" .

lift_definition plus_double :: "double  double  double" is plus
  by (auto simp: is_nan_plus)

lift_definition minus_double :: "double  double  double" is minus
  by (auto simp: is_nan_minus)

lift_definition uminus_double :: "double  double" is uminus
  by auto

lift_definition times_double :: "double  double  double" is times
  by (auto simp: is_nan_times)

lift_definition less_eq_double :: "double  double  bool" is "(≤)"
  by (auto simp: nan_not_le)

lift_definition less_double :: "double  double  bool" is "(<)"
  by (auto simp: nan_not_less)

instance ..

end

instantiation double :: inverse
begin

lift_definition divide_double :: "double  double  double" is divide
  by (auto simp: is_nan_divide)

definition inverse_double :: "double  double" where
  "inverse_double x = 1 div x"

instance ..

end

lift_definition sqrt_double :: "double  double" is float_sqrt
  by (auto simp: is_nan_float_sqrt)

no_notation plus_infinity ("")

lift_definition infinity :: "double" is plus_infinity .

lift_definition nan :: "double" is some_nan .

lift_definition is_zero :: "double  bool" is IEEE.is_zero
  by (auto simp: nan_not_zero)

lift_definition is_infinite :: "double  bool" is IEEE.is_infinity
  by (auto simp: nan_not_infinity)

lift_definition is_nan :: "double  bool" is IEEE.is_nan
  by auto

lemma is_nan_conv: "is_nan x  x = nan"
  by transfer auto

lift_definition copysign_double :: "double  double  double" is
  "λx y. if IEEE.is_nan y then some_nan else copysign x y"
  by auto

text ‹Note: @{const copysign_double} deviates from the IEEE standard in cases where
  the second argument is a NaN.›

lift_definition fcompare_double :: "double  double  ccode" is fcompare
  by (auto simp: nan_fcompare)

lemma nan_fcompare_double: "is_nan x  is_nan y  fcompare_double x y = Und"
  by transfer (rule nan_fcompare)

consts compare_double :: "double  double  integer"

specification (compare_double)
  compare_double_less: "compare_double x y < 0  is_nan x  ¬ is_nan y  fcompare_double x y = ccode.Lt"
  compare_double_eq: "compare_double x y = 0  is_nan x  is_nan y  fcompare_double x y = ccode.Eq"
  compare_double_greater: "compare_double x y > 0  ¬ is_nan x  is_nan y  fcompare_double x y = ccode.Gt"
  by (rule exI[where x="λx y. if is_nan x then if is_nan y then 0 else -1
    else if is_nan y then 1 else (case fcompare_double x y of ccode.Eq  0 | ccode.Lt  -1 | ccode.Gt  1)"],
        transfer, auto simp: fcompare_def)

lemmas compare_double_simps = compare_double_less compare_double_eq compare_double_greater

lemma compare_double_le_0: "compare_double x y  0 
  is_nan x  fcompare_double x y  {ccode.Eq, ccode.Lt}"
  by (rule linorder_cases[of "compare_double x y" 0]; simp)
    (auto simp: compare_double_simps nan_fcompare_double)

lift_definition double_of_integer :: "integer  double" is
  "λx. zerosign 0 (intround To_nearest (int_of_integer x))" .

definition double_of_int where [code del]: "double_of_int x = double_of_integer (integer_of_int x)"

lemma [code]: "double_of_int (int_of_integer x) = double_of_integer x"
  unfolding double_of_int_def by simp

lift_definition integer_of_double :: "double  integer" is
  "λx. if IEEE.is_nan x  IEEE.is_infinity x then undefined
     else integer_of_int valof (intround float_To_zero (valof x) :: (11, 52) float)"
  by auto

definition int_of_double: "int_of_double x = int_of_integer (integer_of_double x)"


subsection ‹Linear ordering›

definition lcompare_double :: "double  double  integer" where
  "lcompare_double x y = (if is_zero x  is_zero y then
      compare_double (copysign_double 1 x) (copysign_double 1 y)
    else compare_double x y)"

lemma fcompare_double_swap: "fcompare_double x y = ccode.Gt  fcompare_double y x = ccode.Lt"
  by transfer (auto simp: fcompare_def)

lemma fcompare_double_refl: "¬ is_nan x  fcompare_double x x = ccode.Eq"
  by transfer (auto simp: fcompare_def)

lemma fcompare_double_Eq1: "fcompare_double x y = ccode.Eq  fcompare_double y z = c  fcompare_double x z = c"
  by transfer (auto simp: fcompare_def split: if_splits)

lemma fcompare_double_Eq2: "fcompare_double y z = ccode.Eq  fcompare_double x y = c  fcompare_double x z = c"
  by transfer (auto simp: fcompare_def split: if_splits)

lemma fcompare_double_Lt_trans: "fcompare_double x y = ccode.Lt  fcompare_double y z = ccode.Lt  fcompare_double x z = ccode.Lt"
  by transfer (auto simp: fcompare_def split: if_splits)

lemma fcompare_double_eq: "¬ is_zero x  ¬ is_zero y  fcompare_double x y = ccode.Eq  x = y"
  by transfer (auto simp: fcompare_def valof_eq IEEE.is_infinity_def split: if_splits intro!: float_eqI)

lemma fcompare_double_Lt_asym: "fcompare_double x y = ccode.Lt  fcompare_double y x = ccode.Lt  False"
  by transfer (auto simp: fcompare_def split: if_splits)

lemma compare_double_swap: "0 < compare_double x y  compare_double y x < 0"
  by (auto simp: compare_double_simps fcompare_double_swap)

lemma compare_double_refl: "compare_double x x = 0"
  by (auto simp: compare_double_eq intro!: fcompare_double_refl)

lemma compare_double_trans: "compare_double x y  0  compare_double y z  0  compare_double x z  0"
  by (fastforce simp: compare_double_le_0 nan_fcompare_double
      dest: fcompare_double_Eq1 fcompare_double_Eq2 fcompare_double_Lt_trans)

lemma compare_double_antisym: "compare_double x y  0  compare_double y x  0 
  ¬ is_zero x  ¬ is_zero y  x = y"
  unfolding compare_double_le_0
  by (auto simp: nan_fcompare_double is_nan_conv
      intro: fcompare_double_eq fcompare_double_eq[symmetric]
      dest: fcompare_double_Lt_asym)

lemma zero_compare_double_copysign: "compare_double (copysign_double 1 x) (copysign_double 1 y)  0 
  is_zero x  is_zero y  compare_double x y  0"
  unfolding compare_double_le_0
  by transfer (auto simp: nan_not_zero zero_fcompare split: if_splits)

lemma is_zero_double_cases: "is_zero x  (x = 0  P)  (x = -0  P)  P"
  by transfer (auto elim!: is_zero_cases)

lemma copysign_1_0[simp]: "copysign_double 1 0 = 1" "copysign_double 1 (-0) = -1"
  by (transfer, simp, transfer, auto)+

lemma is_zero_uminus_double[simp]: "is_zero (- x)  is_zero x"
  by transfer simp

lemma not_is_zero_one_double[simp]: "¬ is_zero 1"
  by (transfer, unfold IEEE.is_zero_def, transfer, simp)

lemma uminus_one_neq_one_double[simp]: "- 1  (1 :: double)"
  by (transfer, transfer, simp)

definition lle_double :: "double  double  bool" where
  "lle_double x y  lcompare_double x y  0"

definition lless_double :: "double  double  bool" where
  "lless_double x y  lcompare_double x y < 0"

lemma lcompare_double_ge_0: "lcompare_double x y  0  lle_double y x"
  unfolding lle_double_def lcompare_double_def
  using compare_double_swap not_less by auto

lemma lcompare_double_gt_0: "lcompare_double x y > 0  lless_double y x"
  unfolding lless_double_def lcompare_double_def
  using compare_double_swap by auto

lemma lcompare_double_eq_0: "lcompare_double x y = 0  x = y"
proof
  assume *: "lcompare_double x y = 0"
  show "x = y" proof (cases "is_zero x  is_zero y")
    case True
    with * show ?thesis
      by (fastforce simp: lcompare_double_def compare_double_simps is_nan_conv
          elim: is_zero_double_cases dest!: fcompare_double_eq[rotated])
  next
    case False
    with * show ?thesis
      by (auto simp: lcompare_double_def linorder_not_less[symmetric] compare_double_swap
          intro!: compare_double_antisym)
  qed
next
  assume "x = y"
  then show "lcompare_double x y = 0"
    by (simp add: lcompare_double_def compare_double_refl)
qed

lemmas lcompare_double_0_folds = lle_double_def[symmetric] lless_double_def[symmetric]
  lcompare_double_ge_0 lcompare_double_gt_0 lcompare_double_eq_0

interpretation double_linorder: linorder lle_double lless_double
proof
  fix x y z :: double
  show "lless_double x y  lle_double x y  ¬ lle_double y x"
    unfolding lless_double_def lle_double_def lcompare_double_def
    by (auto simp: compare_double_swap not_le)
  show "lle_double x x"
    unfolding lle_double_def lcompare_double_def
    by (auto simp: compare_double_refl)
  show "lle_double x z" if "lle_double x y" and "lle_double y z"
    using that
    by (auto 0 3 simp: lle_double_def lcompare_double_def not_le compare_double_swap
        split: if_splits dest: compare_double_trans zero_compare_double_copysign
        zero_compare_double_copysign[OF less_imp_le] compare_double_antisym)
  show "x = y" if "lle_double x y" and "lle_double y x"
  proof (cases "is_zero x  is_zero y")
    case True
    with that show ?thesis
      by (auto 0 3 simp: lle_double_def lcompare_double_def elim: is_zero_double_cases
          dest!: compare_double_antisym)
  next
    case False
    with that show ?thesis
      by (auto simp: lle_double_def lcompare_double_def elim!: compare_double_antisym)
  qed
  show "lle_double x y  lle_double y x"
    unfolding lle_double_def lcompare_double_def
    by (auto simp: compare_double_swap not_le)
qed

instantiation double :: equal
begin

definition equal_double :: "double  double  bool" where
  "equal_double x y  lcompare_double x y = 0"

instance by intro_classes (simp add: equal_double_def lcompare_double_eq_0)

end

derive (eq) ceq double

definition comparator_double :: "double comparator" where
  "comparator_double x y = (let c = lcompare_double x y in
    if c = 0 then order.Eq else if c < 0 then order.Lt else order.Gt)"

lemma comparator_double: "comparator comparator_double"
  unfolding comparator_double_def
  by (auto simp: lcompare_double_0_folds split: if_splits intro!: comparator.intro)

local_setup Comparator_Generator.register_foreign_comparator @{typ double}
    @{term comparator_double}
    @{thm comparator_double}

derive ccompare double


subsubsection ‹Code setup›

declare [[code drop:
      "0 :: double"
      "1 :: double"
      "plus :: double  _"
      "minus :: double  _"
      "uminus :: double  _"
      "times :: double  _"
      "less_eq :: double  _"
      "less :: double  _"
      "divide :: double  _"
      sqrt_double infinity nan is_zero is_infinite is_nan copysign_double fcompare_double
      double_of_integer integer_of_double
      ]]

code_printing
  code_module FloatUtil  (OCaml)
‹module FloatUtil : sig
  val iszero : float -> bool
  val isinfinite : float -> bool
  val isnan : float -> bool
  val copysign : float -> float -> float
  val compare : float -> float -> Z.t
end = struct
  let iszero x = (Pervasives.classify_float x = Pervasives.FP_zero);;
  let isinfinite x = (Pervasives.classify_float x = Pervasives.FP_infinite);;
  let isnan x = (Pervasives.classify_float x = Pervasives.FP_nan);;
  let copysign x y = if isnan y then Pervasives.nan else Pervasives.copysign x y;;
  let compare x y = Z.of_int (Pervasives.compare x y);;
end;;›

code_reserved OCaml Pervasives FloatUtil

code_printing
  type_constructor double  (OCaml) "float"
  | constant "uminus :: double  double"  (OCaml) "Pervasives.(~-.)"
  | constant "(+) :: double  double  double"  (OCaml) "Pervasives.(+.)"
  | constant "(*) :: double  double  double"  (OCaml) "Pervasives.( *. )"
  | constant "(/) :: double  double  double"  (OCaml) "Pervasives.('/.)"
  | constant "(-) :: double  double  double"  (OCaml) "Pervasives.(-.)"
  | constant "0 :: double"  (OCaml) "0.0"
  | constant "1 :: double"  (OCaml) "1.0"
  | constant "(≤) :: double  double  bool"  (OCaml) "Pervasives.(<=)"
  | constant "(<) :: double  double  bool"  (OCaml) "Pervasives.(<)"
  | constant "sqrt_double :: double  double"  (OCaml) "Pervasives.sqrt"
  | constant "infinity :: double"  (OCaml) "Pervasives.infinity"
  | constant "nan :: double"  (OCaml) "Pervasives.nan"
  | constant "is_zero :: double  bool"  (OCaml) "FloatUtil.iszero"
  | constant "is_infinite :: double  bool"  (OCaml) "FloatUtil.isinfinite"
  | constant "is_nan :: double  bool"  (OCaml) "FloatUtil.isnan"
  | constant "copysign_double :: double  double  double"  (OCaml) "FloatUtil.copysign"
  | constant "compare_double :: double  double  integer"  (OCaml) "FloatUtil.compare"
  | constant "double_of_integer :: integer  double"  (OCaml) "Z.to'_float"
  | constant "integer_of_double :: double  integer"  (OCaml) "Z.of'_float"

hide_const (open) fcompare_double

(*<*)
end
(*>*)

Theory Event_Data

(*<*)
theory Event_Data
  imports
    "HOL-Library.Char_ord"
    Code_Double
    Deriving.Derive
begin
(*>*)

section ‹Event parameters›

definition div_to_zero :: "integer  integer  integer" where
  "div_to_zero x y = (let z = fst (Code_Numeral.divmod_abs x y) in
    if (x < 0)  (y < 0) then - z else z)"

definition mod_to_zero :: "integer  integer  integer" where
  "mod_to_zero x y = (let z = snd (Code_Numeral.divmod_abs x y) in
    if x < 0 then - z else z)"

lemma "b  0  div_to_zero a b * b + mod_to_zero a b = a"
  unfolding div_to_zero_def mod_to_zero_def Let_def
  by (auto simp: minus_mod_eq_mult_div[symmetric] div_minus_right mod_minus_right ac_simps)


datatype event_data = EInt integer | EFloat double | EString String.literal

derive (eq) ceq event_data
derive ccompare event_data

instantiation event_data :: "{ord, plus, minus, uminus, times, divide, modulo}"
begin

fun less_eq_event_data where
  "EInt x  EInt y  x  y"
| "EInt x  EFloat y  double_of_integer x  y"
| "EInt _  EString _  False"
| "EFloat x  EInt y  x  double_of_integer y"
| "EFloat x  EFloat y  x  y"
| "EFloat _  EString _  False"
| "EString x  EString y  lexordp_eq (String.explode x) (String.explode y)"
| "EString _  _  False"

definition less_event_data :: "event_data  event_data  bool"  where
  "less_event_data x y  x  y  ¬ y  x"

fun plus_event_data where
  "EInt x + EInt y = EInt (x + y)"
| "EInt x + EFloat y = EFloat (double_of_integer x + y)"
| "EFloat x + EInt y = EFloat (x + double_of_integer y)"
| "EFloat x + EFloat y = EFloat (x + y)"
| "(_::event_data) + _ = EFloat nan"

fun minus_event_data where
  "EInt x - EInt y = EInt (x - y)"
| "EInt x - EFloat y = EFloat (double_of_integer x - y)"
| "EFloat x - EInt y = EFloat (x - double_of_integer y)"
| "EFloat x - EFloat y = EFloat (x - y)"
| "(_::event_data) - _ = EFloat nan"

fun uminus_event_data where
  "- EInt x = EInt (- x)"
| "- EFloat x = EFloat (- x)"
| "- (_::event_data) = EFloat nan"

fun times_event_data where
  "EInt x * EInt y = EInt (x * y)"
| "EInt x * EFloat y = EFloat (double_of_integer x * y)"
| "EFloat x * EInt y = EFloat (x * double_of_integer y)"
| "EFloat x * EFloat y = EFloat (x * y)"
| "(_::event_data) * _ = EFloat nan"

fun divide_event_data where
  "EInt x div EInt y = EInt (div_to_zero x y)"
| "EInt x div EFloat y = EFloat (double_of_integer x div y)"
| "EFloat x div EInt y = EFloat (x div double_of_integer y)"
| "EFloat x div EFloat y = EFloat (x div y)"
| "(_::event_data) div _ = EFloat nan"

fun modulo_event_data where
  "EInt x mod EInt y = EInt (mod_to_zero x y)"
| "(_::event_data) mod _ = EFloat nan"

instance ..

end

primrec integer_of_event_data :: "event_data  integer" where
  "integer_of_event_data (EInt x) = x"
| "integer_of_event_data (EFloat x) = integer_of_double x"
| "integer_of_event_data (EString _) = 0"

primrec double_of_event_data :: "event_data  double" where
  "double_of_event_data (EInt x) = double_of_integer x"
| "double_of_event_data (EFloat x) = x"
| "double_of_event_data (EString _) = nan"

(*<*)
end
(*>*)

Theory Regex

(*<*)
theory Regex
  imports
    "MFOTL_Monitor.Trace"
    "HOL-Library.Lattice_Syntax"
    "HOL-Library.Extended_Nat"
begin
(*>*)

section ‹Regular expressions›

context begin

qualified datatype (atms: 'a) regex = Skip nat | Test 'a
  | Plus "'a regex" "'a regex" | Times "'a regex" "'a regex"  | Star "'a regex"

lemma finite_atms[simp]: "finite (atms r)"
  by (induct r) auto

definition "Wild = Skip 1"

lemma size_regex_estimation[termination_simp]: "x  atms r  y < f x  y < size_regex f r"
  by (induct r) auto

lemma size_regex_estimation'[termination_simp]: "x  atms r  y  f x  y  size_regex f r"
  by (induct r) auto

qualified definition "TimesL r S = Times r ` S"
qualified definition "TimesR R s = (λr. Times r s) ` R"

qualified primrec fv_regex where
  "fv_regex fv (Skip n) = {}"
| "fv_regex fv (Test φ) = fv φ"
| "fv_regex fv (Plus r s) = fv_regex fv r  fv_regex fv s"
| "fv_regex fv (Times r s) = fv_regex fv r  fv_regex fv s"
| "fv_regex fv (Star r) = fv_regex fv r"

lemma fv_regex_cong[fundef_cong]:
  "r = r'  (z. z  atms r  fv z = fv' z)  fv_regex fv r = fv_regex fv' r'"
  by (induct r arbitrary: r') auto

lemma finite_fv_regex[simp]: "(z. z  atms r  finite (fv z))  finite (fv_regex fv r)"
  by (induct r) auto

lemma fv_regex_commute:
  "(z. z  atms r  x  fv z  g x  fv' z)  x  fv_regex fv r  g x  fv_regex fv' r"
  by (induct r) auto

lemma fv_regex_alt: "fv_regex fv r = (z  atms r. fv z)"
  by (induct r) auto

qualified definition nfv_regex where
  "nfv_regex fv r = Max (insert 0 (Suc ` fv_regex fv r))"

lemma insert_Un: "insert x (A  B) = insert x A  insert x B"
  by auto

lemma nfv_regex_simps[simp]:
  assumes [simp]: "(z. z  atms r  finite (fv z))" "(z. z  atms s  finite (fv z))"
  shows
  "nfv_regex fv (Skip n) = 0"
  "nfv_regex fv (Test φ) = Max (insert 0 (Suc ` fv φ))"
  "nfv_regex fv (Plus r s) = max (nfv_regex fv r) (nfv_regex fv s)"
  "nfv_regex fv (Times r s) = max (nfv_regex fv r) (nfv_regex fv s)"
  "nfv_regex fv (Star r) = nfv_regex fv r"
  unfolding nfv_regex_def
  by (auto simp add: image_Un Max_Un insert_Un simp del: Un_insert_right Un_insert_left)

abbreviation "min_regex_default f r j  (if atms r = {} then j else Min ((λz. f z j) ` atms r))"

qualified primrec match :: "(nat  'a  bool)  'a regex  nat  nat  bool" where
  "match test (Skip n) = (λi j. j = i + n)"
| "match test (Test φ) = (λi j. i = j  test i φ)"
| "match test (Plus r s) = match test r  match test s"
| "match test (Times r s) = match test r OO match test s"
| "match test (Star r) = (match test r)**"

lemma match_cong[fundef_cong]:
  "r = r'  (i z. z  atms r  t i z = t' i z)  match t r = match t' r'"
  by (induct r arbitrary: r') auto

qualified primrec eps where
  "eps test i (Skip n) = (n = 0)"
| "eps test i (Test φ) = test i φ"
| "eps test i (Plus r s) = (eps test i r  eps test i s)"
| "eps test i (Times r s) = (eps test i r  eps test i s)"
| "eps test i (Star r) = True"

qualified primrec lpd where
  "lpd test i (Skip n) = (case n of 0  {} | Suc m  {Skip m})"
| "lpd test i (Test φ) = {}"
| "lpd test i (Plus r s) = (lpd test i r  lpd test i s)"
| "lpd test i (Times r s) = TimesR (lpd test i r) s  (if eps test i r then lpd test i s else {})"
| "lpd test i (Star r) = TimesR (lpd test i r) (Star r)"

qualified primrec lpdκ where
  "lpdκ κ test i (Skip n) = (case n of 0  {} | Suc m  {κ (Skip m)})"
| "lpdκ κ test i (Test φ) = {}"
| "lpdκ κ test i (Plus r s) = lpdκ κ test i r  lpdκ κ test i s"
| "lpdκ κ test i (Times r s) = lpdκ (λt. κ (Times t s)) test i r  (if eps test i r then lpdκ κ test i s else {})"
| "lpdκ κ test i (Star r) = lpdκ (λt. κ (Times t (Star r))) test i r"

qualified primrec rpd where
  "rpd test i (Skip n) = (case n of 0  {} | Suc m  {Skip m})"
| "rpd test i (Test φ) = {}"
| "rpd test i (Plus r s) = (rpd test i r  rpd test i s)"
| "rpd test i (Times r s) = TimesL r (rpd test i s)  (if eps test i s then rpd test i r else {})"
| "rpd test i (Star r) = TimesL (Star r) (rpd test i r)"

qualified primrec rpdκ where
  "rpdκ κ test i (Skip n) = (case n of 0  {} | Suc m  {κ (Skip m)})"
| "rpdκ κ test i (Test φ) = {}"
| "rpdκ κ test i (Plus r s) = rpdκ κ test i r  rpdκ κ test i s"
| "rpdκ κ test i (Times r s) = rpdκ (λt. κ (Times r t)) test i s  (if eps test i s then rpdκ κ test i r else {})"
| "rpdκ κ test i (Star r) = rpdκ (λt. κ (Times (Star r) t)) test i r"

lemma lpdκ_lpd: "lpdκ κ test i r = κ ` lpd test i r"
  by (induct r arbitrary: κ) (auto simp: TimesR_def split: nat.splits)

lemma rpdκ_rpd: "rpdκ κ test i r = κ ` rpd test i r"
  by (induct r arbitrary: κ) (auto simp: TimesL_def split: nat.splits)

lemma match_le: "match test r i j  i  j"
proof (induction r arbitrary: i j)
  case (Times r s)
  then show ?case using order.trans by fastforce
next
  case (Star r)
  from Star.prems show ?case
    unfolding match.simps by (induct i j rule: rtranclp.induct) (force dest: Star.IH)+
qed auto

lemma match_rtranclp_le: "(match test r)** i j  i  j"
  by (metis match.simps(5) match_le)

lemma eps_match: "eps test i r  match test r i i"
  by (induction r) (auto dest: antisym[OF match_le match_le])

lemma lpd_match: "i < j  match test r i j  (s  lpd test i r. match test s) (i + 1) j"
proof (induction r arbitrary: i j)
  case (Times r s)
  have "match test (Times r s) i j  (k. match test r i k  match test s k j)"
    by auto
  also have "  match test r i i  match test s i j 
    (k>i. match test r i k  match test s k j)"
    using match_le[of test r i] nat_less_le by auto
  also have "  match test r i i  (t  lpd test i s. match test t) (i + 1) j 
    (k>i. (t  lpd test i r. match test t) (i + 1) k  match test s k j)"
    using Times.IH(1) Times.IH(2)[OF Times.prems] by metis
  also have "  match test r i i  (t  lpd test i s. match test t) (i + 1) j 
    (k. (t  lpd test i r. match test t) (i + 1) k  match test s k j)"
    using Times.prems by (intro disj_cong[OF refl] iff_exI) (auto dest: match_le)
  also have "  ( (match test ` lpd test i (Times r s))) (i + 1) j"
    by (force simp: TimesL_def TimesR_def eps_match)
  finally show ?case .
next
  case (Star r)
  have "slpd test i r. (match test s OO (match test r)**) (i + 1) j" if "(match test r)** i j"
    using that Star.prems match_le[of test _ "i + 1"]
  proof (induct rule: converse_rtranclp_induct)
    case (step i k)
    then show ?case
      by (cases "i < k") (auto simp: not_less Star.IH dest: match_le)
  qed simp
  with Star.prems show ?case using match_le[of test _  "i + 1"]
    by (auto simp: TimesL_def TimesR_def Suc_le_eq Star.IH[of i]
      elim!: converse_rtranclp_into_rtranclp[rotated])
qed (auto split: nat.splits)

lemma rpd_match: "i < j  match test r i j  (s  rpd test j r. match test s) i (j - 1)"
proof (induction r arbitrary: i j)
  case (Times r s)
  have "match test (Times r s) i j  (k. match test r i k  match test s k j)"
    by auto
  also have "  match test r i j  match test s j j 
    (k<j. match test r i k  match test s k j)"
    using match_le[of test s _ j] nat_less_le by auto
  also have "  (t  rpd test j r. match test t) i (j - 1)  match test s j j  
    (k<j. match test r i k  (t  rpd test j s. match test t) k (j - 1))"
    using Times.IH(1)[OF Times.prems] Times.IH(2) by metis
  also have "  (t  rpd test j r. match test t) i (j - 1)  match test s j j  
    (k. match test r i k  (t  rpd test j s. match test t) k (j - 1))"
    using Times.prems by (intro disj_cong[OF refl] iff_exI) (auto dest: match_le)
  also have "  ( (match test ` rpd test j (Times r s))) i (j - 1)"
    by (force simp: TimesL_def TimesR_def eps_match)
  finally show ?case .
next
  case (Star r)
  have "srpd test j r. ((match test r)** OO match test s) i (j - 1)" if "(match test r)** i j"
    using that Star.prems match_le[of test _ _ "j - 1"]
  proof (induct rule: rtranclp_induct)
    case (step k j)
    then show ?case
      by (cases "k < j") (auto simp: not_less Star.IH dest: match_le)
  qed simp
  with Star.prems show ?case
    by (auto 0 3 simp: TimesL_def TimesR_def intro: Star.IH[of _ j, THEN iffD2]
      elim!: rtranclp.rtrancl_into_rtrancl dest: match_le[of test _ _ "j - 1", unfolded One_nat_def])
qed (auto split: nat.splits)

lemma lpd_fv_regex: "s  lpd test i r  fv_regex fv s  fv_regex fv r"
  by (induct r arbitrary: s) (auto simp: TimesR_def TimesL_def split: if_splits nat.splits)+

lemma rpd_fv_regex: "s  rpd test i r  fv_regex fv s  fv_regex fv r"
  by (induct r arbitrary: s) (auto simp: TimesR_def TimesL_def split: if_splits nat.splits)+

lemma match_fv_cong:
  "(i x. x  atms r  test i x = test' i x)  match test r = match test' r"
  by (induct r) auto

lemma eps_fv_cong:
  "(i x. x  atms r  test i x = test' i x)  eps test i r = eps test' i r"
  by (induct r) auto

datatype modality = Past | Futu
datatype safety = Strict | Lax

context
  fixes fv :: "'a  'b set"
  and safe :: "safety  'a  bool"
begin

qualified fun safe_regex :: "modality  safety  'a regex  bool" where
  "safe_regex m _ (Skip n) = True"
| "safe_regex m g (Test φ) = safe g φ"
| "safe_regex m g (Plus r s) = ((g = Lax  fv_regex fv r = fv_regex fv s)  safe_regex m g r  safe_regex m g s)"
| "safe_regex Futu g (Times r s) =
    ((g = Lax  fv_regex fv r  fv_regex fv s)  safe_regex Futu g s  safe_regex Futu Lax r)"
| "safe_regex Past g (Times r s) =
    ((g = Lax  fv_regex fv s  fv_regex fv r)  safe_regex Past g r  safe_regex Past Lax s)"
| "safe_regex m g (Star r) = ((g = Lax  fv_regex fv r = {})  safe_regex m g r)"

lemmas safe_regex_induct = safe_regex.induct[case_names Skip Test Plus TimesF TimesP Star]

lemma safe_cosafe:
  "(x. x  atms r  safe Strict x  safe Lax x)  safe_regex m Strict r  safe_regex m Lax r"
  by (induct r; cases m) auto

lemma safe_lpd_fv_regex_le: "safe_regex Futu Strict r  s  lpd test i r  fv_regex fv r  fv_regex fv s"
  by (induct r) (auto simp: TimesR_def split: if_splits)

lemma safe_lpd_fv_regex: "safe_regex Futu Strict r  s  lpd test i r  fv_regex fv s = fv_regex fv r"
  by (simp add: eq_iff lpd_fv_regex safe_lpd_fv_regex_le)

lemma cosafe_lpd: "safe_regex Futu Lax r  s  lpd test i r  safe_regex Futu Lax s"
proof (induct r arbitrary: s)
  case (Plus r1 r2)
  from Plus(3,4) show ?case
    by (auto elim: Plus(1,2))
next
  case (Times r1 r2)
  from Times(3,4) show ?case
    by (auto simp: TimesR_def elim: Times(1,2) split: if_splits)
qed (auto simp: TimesR_def split: nat.splits)

lemma safe_lpd: "(x  atms r. safe Strict x  safe Lax x) 
  safe_regex Futu Strict r  s  lpd test i r  safe_regex Futu Strict s"
proof (induct r arbitrary: s)
  case (Plus r1 r2)
  from Plus(3,4,5) show ?case
    by (auto elim: Plus(1,2) simp: ball_Un)
next
  case (Times r1 r2)
  from Times(3,4,5) show ?case
    by (force simp: TimesR_def ball_Un elim: Times(1,2) cosafe_lpd dest: lpd_fv_regex split: if_splits)
next
  case (Star r)
  from Star(2,3,4) show ?case
    by (force simp: TimesR_def elim: Star(1) cosafe_lpd
      dest: safe_cosafe[rotated] lpd_fv_regex[where fv=fv] split: if_splits)
qed (auto split: nat.splits)

lemma safe_rpd_fv_regex_le: "safe_regex Past Strict r  s  rpd test i r  fv_regex fv r  fv_regex fv s"
  by (induct r) (auto simp: TimesL_def split: if_splits)

lemma safe_rpd_fv_regex: "safe_regex Past Strict r  s  rpd test i r  fv_regex fv s = fv_regex fv r"
  by (simp add: eq_iff rpd_fv_regex safe_rpd_fv_regex_le)

lemma cosafe_rpd: "safe_regex Past Lax r  s  rpd test i r  safe_regex Past Lax s"
proof (induct r arbitrary: s)
  case (Plus r1 r2)
  from Plus(3,4) show ?case
    by (auto elim: Plus(1,2))
next
  case (Times r1 r2)
  from Times(3,4) show ?case
    by (auto simp: TimesL_def elim: Times(1,2) split: if_splits)
qed (auto simp: TimesL_def split: nat.splits)

lemma safe_rpd: "(x  atms r. safe Strict x  safe Lax x) 
  safe_regex Past Strict r  s  rpd test i r  safe_regex Past Strict s"
proof (induct r arbitrary: s)
  case (Plus r1 r2)
  from Plus(3,4,5) show ?case
    by (auto elim: Plus(1,2) simp: ball_Un)
next
  case (Times r1 r2)
  from Times(3,4,5) show ?case
    by (force simp: TimesL_def ball_Un elim: Times(1,2) cosafe_rpd dest: rpd_fv_regex split: if_splits)
next
  case (Star r)
  from Star(2,3,4) show ?case
    by (force simp: TimesL_def elim: Star(1) cosafe_rpd
      dest: safe_cosafe[rotated] rpd_fv_regex[where fv=fv] split: if_splits)
qed (auto split: nat.splits)

lemma safe_regex_safe: "(g r. safe g r  safe Lax r) 
  safe_regex m g r  x  atms r  safe Lax x"
  by (induct m g r rule: safe_regex.induct) auto

lemma safe_regex_map_regex:
  "(g x. x  atms r  safe g x   safe g (f x))  (x. x  atms r  fv (f x) = fv x) 
   safe_regex m g r  safe_regex m g (map_regex f r)"
  by (induct m g r rule: safe_regex.induct) (auto simp: fv_regex_alt regex.set_map)

end

lemma safe_regex_cong[fundef_cong]:
  "(g x. x  atms r  safe g x = safe' g x) 
  Regex.safe_regex fv safe m g r = Regex.safe_regex fv safe' m g r"
  by (induct m g r rule: safe_regex.induct) auto

lemma safe_regex_mono:
  "(g x. x  atms r  safe g x  safe' g x) 
  Regex.safe_regex fv safe m g r  Regex.safe_regex fv safe' m g r"
  by (induct m g r rule: safe_regex.induct) auto

lemma match_map_regex: "match t (map_regex f r) = match (λk z. t k (f z)) r"
  by (induct r) auto

lemma match_cong_strong:
  "(k z. k  {i ..< j + 1}  z  atms r  t k z = t' k z)  match t r i j = match t' r i j"
proof (induction r arbitrary: i j)
  case (Times r s)
  from Times.prems show ?case
    by (auto 0 4 simp: relcompp_apply intro: le_less_trans match_le less_Suc_eq_le
      dest: Times.IH[THEN iffD1, rotated -1] Times.IH[THEN iffD2, rotated -1] match_le)
next
  case (Star r)
  show ?case unfolding match.simps
  proof (rule iffI)
    assume *: "(match t r)** i j"
    then have "i  j" unfolding match.simps(5)[symmetric]
      by (rule match_le)
    with * show "(match t' r)** i j" using Star.prems
    proof (induction i j rule: rtranclp.induct)
      case (rtrancl_into_rtrancl a b c)
      from rtrancl_into_rtrancl(1,2,4,5) show ?case
        by (intro rtranclp.rtrancl_into_rtrancl[OF rtrancl_into_rtrancl.IH])
          (auto dest!: Star.IH[THEN iffD1, rotated -1]
            dest: match_le match_rtranclp_le simp: less_Suc_eq_le)
    qed simp
  next
    assume *: "(match t' r)** i j"
    then have "i  j" unfolding match.simps(5)[symmetric]
      by (rule match_le)
    with * show "(match t r)** i j" using Star.prems
    proof (induction i j rule: rtranclp.induct)
      case (rtrancl_into_rtrancl a b c)
      from rtrancl_into_rtrancl(1,2,4,5) show ?case
        by (intro rtranclp.rtrancl_into_rtrancl[OF rtrancl_into_rtrancl.IH])
          (auto dest!: Star.IH[THEN iffD2, rotated -1]
            dest: match_le match_rtranclp_le simp: less_Suc_eq_le)
    qed simp
  qed
qed auto

end

(*<*)
end
(*>*)

Theory Formula

(*<*)
theory Formula
  imports
    Event_Data
    Regex
    "MFOTL_Monitor.Interval"
    "MFOTL_Monitor.Trace"
    "MFOTL_Monitor.Abstract_Monitor"
    "HOL-Library.Mapping"
    Containers.Set_Impl
begin
(*>*)

section ‹Metric first-order dynamic logic›

derive (eq) ceq enat

instantiation enat :: ccompare begin
definition ccompare_enat :: "enat comparator option" where
  "ccompare_enat = Some (λx y. if x = y then order.Eq else if x < y then order.Lt else order.Gt)"

instance by intro_classes
    (auto simp: ccompare_enat_def split: if_splits intro!: comparator.intro)
end

context begin

subsection ‹Formulas and satisfiability›

qualified type_synonym name = String.literal
qualified type_synonym event = "(name × event_data list)"
qualified type_synonym database = "(name, event_data list set list) mapping"
qualified type_synonym prefix = "(name × event_data list) prefix"
qualified type_synonym trace = "(name × event_data list) trace"

qualified type_synonym env = "event_data list"

subsubsection ‹Syntax›

qualified datatype trm = is_Var: Var nat | is_Const: Const event_data
  | Plus trm trm | Minus trm trm | UMinus trm | Mult trm trm | Div trm trm | Mod trm trm
  | F2i trm | I2f trm

qualified primrec fvi_trm :: "nat  trm  nat set" where
  "fvi_trm b (Var x) = (if b  x then {x - b} else {})"
| "fvi_trm b (Const _) = {}"
| "fvi_trm b (Plus x y) = fvi_trm b x  fvi_trm b y"
| "fvi_trm b (Minus x y) = fvi_trm b x  fvi_trm b y"
| "fvi_trm b (UMinus x) = fvi_trm b x"
| "fvi_trm b (Mult x y) = fvi_trm b x  fvi_trm b y"
| "fvi_trm b (Div x y) = fvi_trm b x  fvi_trm b y"
| "fvi_trm b (Mod x y) = fvi_trm b x  fvi_trm b y"
| "fvi_trm b (F2i x) = fvi_trm b x"
| "fvi_trm b (I2f x) = fvi_trm b x"

abbreviation "fv_trm  fvi_trm 0"

qualified primrec eval_trm :: "env  trm  event_data" where
  "eval_trm v (Var x) = v ! x"
| "eval_trm v (Const x) = x"
| "eval_trm v (Plus x y) = eval_trm v x + eval_trm v y"
| "eval_trm v (Minus x y) = eval_trm v x - eval_trm v y"
| "eval_trm v (UMinus x) = - eval_trm v x"
| "eval_trm v (Mult x y) = eval_trm v x * eval_trm v y"
| "eval_trm v (Div x y) = eval_trm v x div eval_trm v y"
| "eval_trm v (Mod x y) = eval_trm v x mod eval_trm v y"
| "eval_trm v (F2i x) = EInt (integer_of_event_data (eval_trm v x))"
| "eval_trm v (I2f x) = EFloat (double_of_event_data (eval_trm v x))"

lemma eval_trm_fv_cong: "xfv_trm t. v ! x = v' ! x  eval_trm v t = eval_trm v' t"
  by (induction t) simp_all


qualified datatype agg_type = Agg_Cnt | Agg_Min | Agg_Max | Agg_Sum | Agg_Avg | Agg_Med
qualified type_synonym agg_op = "agg_type × event_data"

definition flatten_multiset :: "(event_data × enat) set  event_data list" where
  "flatten_multiset M = concat (map (λ(x, c). replicate (the_enat c) x) (csorted_list_of_set M))"

fun eval_agg_op :: "agg_op  (event_data × enat) set  event_data" where
  "eval_agg_op (Agg_Cnt, y0) M = EInt (integer_of_int (length (flatten_multiset M)))"
| "eval_agg_op (Agg_Min, y0) M = (case flatten_multiset M of
      []  y0
    | x # xs  foldl min x xs)"
| "eval_agg_op (Agg_Max, y0) M = (case flatten_multiset M of
      []  y0
    | x # xs  foldl max x xs)"
| "eval_agg_op (Agg_Sum, y0) M = foldl plus y0 (flatten_multiset M)"
| "eval_agg_op (Agg_Avg, y0) M = EFloat (let xs = flatten_multiset M in case xs of
      []  0
    | _  double_of_event_data (foldl plus (EInt 0) xs) / double_of_int (length xs))"
| "eval_agg_op (Agg_Med, y0) M = EFloat (let xs = flatten_multiset M; u = length xs in
    if u = 0 then 0 else
      let u' = u div 2 in
      if even u then
        (double_of_event_data (xs ! (u'-1)) + double_of_event_data (xs ! u') / double_of_int 2)
      else double_of_event_data (xs ! u'))"

qualified datatype (discs_sels) formula = Pred name "trm list"
  | Let name formula formula
  | Eq trm trm | Less trm trm | LessEq trm trm
  | Neg formula | Or formula formula | And formula formula | Ands "formula list" | Exists formula
  | Agg nat agg_op nat trm formula
  | Prev  formula | Next  formula
  | Since formula  formula | Until formula  formula
  | MatchF  "formula Regex.regex" | MatchP  "formula Regex.regex"

qualified definition "FF = Exists (Neg (Eq (Var 0) (Var 0)))"
qualified definition "TT  Neg FF"

qualified fun fvi :: "nat  formula  nat set" where
  "fvi b (Pred r ts) = (tset ts. fvi_trm b t)"
| "fvi b (Let p φ ψ) = fvi b ψ"
| "fvi b (Eq t1 t2) = fvi_trm b t1  fvi_trm b t2"
| "fvi b (Less t1 t2) = fvi_trm b t1  fvi_trm b t2"
| "fvi b (LessEq t1 t2) = fvi_trm b t1  fvi_trm b t2"
| "fvi b (Neg φ) = fvi b φ"
| "fvi b (Or φ ψ) = fvi b φ  fvi b ψ"
| "fvi b (And φ ψ) = fvi b φ  fvi b ψ"
| "fvi b (Ands φs) = (let xs = map (fvi b) φs in xset xs. x)"
| "fvi b (Exists φ) = fvi (Suc b) φ"
| "fvi b (Agg y ω b' f φ) = fvi (b + b') φ  fvi_trm (b + b') f  (if b  y then {y - b} else {})"
| "fvi b (Prev I φ) = fvi b φ"
| "fvi b (Next I φ) = fvi b φ"
| "fvi b (Since φ I ψ) = fvi b φ  fvi b ψ"
| "fvi b (Until φ I ψ) = fvi b φ  fvi b ψ"
| "fvi b (MatchF I r) = Regex.fv_regex (fvi b) r"
| "fvi b (MatchP I r) = Regex.fv_regex (fvi b) r"

abbreviation "fv  fvi 0"
abbreviation "fv_regex  Regex.fv_regex fv"

lemma fv_abbrevs[simp]: "fv TT = {}" "fv FF = {}"
  unfolding TT_def FF_def by auto

lemma fv_subset_Ands: "φ  set φs  fv φ  fv (Ands φs)"
  by auto

lemma finite_fvi_trm[simp]: "finite (fvi_trm b t)"
  by (induction t) simp_all

lemma finite_fvi[simp]: "finite (fvi b φ)"
  by (induction φ arbitrary: b) simp_all

lemma fvi_trm_plus: "x  fvi_trm (b + c) t  x + c  fvi_trm b t"
  by (induction t) auto

lemma fvi_trm_iff_fv_trm: "x  fvi_trm b t  x + b  fv_trm t"
  using fvi_trm_plus[where b=0 and c=b] by simp_all

lemma fvi_plus: "x  fvi (b + c) φ  x + c  fvi b φ"
proof (induction φ arbitrary: b rule: formula.induct)
  case (Exists φ)
  then show ?case by force
next
  case (Agg y ω b' f φ)
  have *: "b + c + b' = b + b' + c" by simp
  from Agg show ?case by (force simp: * fvi_trm_plus)
qed (auto simp add: fvi_trm_plus fv_regex_commute[where g = "λx. x + c"])

lemma fvi_Suc: "x  fvi (Suc b) φ  Suc x  fvi b φ"
  using fvi_plus[where c=1] by simp

lemma fvi_plus_bound:
  assumes "ifvi (b + c) φ. i < n"
  shows "ifvi b φ. i < c + n"
proof
  fix i
  assume "i  fvi b φ"
  show "i < c + n"
  proof (cases "i < c")
    case True
    then show ?thesis by simp
  next
    case False
    then obtain i' where "i = i' + c"
      using nat_le_iff_add by (auto simp: not_less)
    with assms i  fvi b φ show ?thesis by (simp add: fvi_plus)
  qed
qed

lemma fvi_Suc_bound:
  assumes "ifvi (Suc b) φ. i < n"
  shows "ifvi b φ. i < Suc n"
  using assms fvi_plus_bound[where c=1] by simp

lemma fvi_iff_fv: "x  fvi b φ  x + b  fv φ"
  using fvi_plus[where b=0 and c=b] by simp_all

qualified definition nfv :: "formula  nat" where
  "nfv φ = Max (insert 0 (Suc ` fv φ))"

qualified abbreviation nfv_regex where
  "nfv_regex  Regex.nfv_regex fv"

qualified definition envs :: "formula  env set" where
  "envs φ = {v. length v = nfv φ}"

lemma nfv_simps[simp]:
  "nfv (Let p φ ψ) = nfv ψ"
  "nfv (Neg φ) = nfv φ"
  "nfv (Or φ ψ) = max (nfv φ) (nfv ψ)"
  "nfv (And φ ψ) = max (nfv φ) (nfv ψ)"
  "nfv (Prev I φ) = nfv φ"
  "nfv (Next I φ) = nfv φ"
  "nfv (Since φ I ψ) = max (nfv φ) (nfv ψ)"
  "nfv (Until φ I ψ) = max (nfv φ) (nfv ψ)"
  "nfv (MatchP I r) = Regex.nfv_regex fv r"
  "nfv (MatchF I r) = Regex.nfv_regex fv r"
  "nfv_regex (Regex.Skip n) = 0"
  "nfv_regex (Regex.Test φ) = Max (insert 0 (Suc ` fv φ))"
  "nfv_regex (Regex.Plus r s) = max (nfv_regex r) (nfv_regex s)"
  "nfv_regex (Regex.Times r s) = max (nfv_regex r) (nfv_regex s)"
  "nfv_regex (Regex.Star r) = nfv_regex r"
  unfolding nfv_def Regex.nfv_regex_def by (simp_all add: image_Un Max_Un[symmetric])

lemma nfv_Ands[simp]: "nfv (Ands l) = Max (insert 0 (nfv ` set l))"
proof (induction l)
  case Nil
  then show ?case unfolding nfv_def by simp
next
  case (Cons a l)
  have "fv (Ands (a # l)) = fv a  fv (Ands l)" by simp
  then have "nfv (Ands (a # l)) = max (nfv a) (nfv (Ands l))"
    unfolding nfv_def
    by (auto simp: image_Un Max.union[symmetric])
  with Cons.IH show ?case
    by (cases l) auto
qed

lemma fvi_less_nfv: "ifv φ. i < nfv φ"
  unfolding nfv_def
  by (auto simp add: Max_gr_iff intro: max.strict_coboundedI2)

lemma fvi_less_nfv_regex: "ifv_regex φ. i < nfv_regex φ"
  unfolding Regex.nfv_regex_def
  by (auto simp add: Max_gr_iff intro: max.strict_coboundedI2)

subsubsection ‹Future reach›

qualified fun future_bounded :: "formula  bool" where
  "future_bounded (Pred _ _) = True"
| "future_bounded (Let p φ ψ) = (future_bounded φ  future_bounded ψ)"
| "future_bounded (Eq _ _) = True"
| "future_bounded (Less _ _) = True"
| "future_bounded (LessEq _ _) = True"
| "future_bounded (Neg φ) = future_bounded φ"
| "future_bounded (Or φ ψ) = (future_bounded φ  future_bounded ψ)"
| "future_bounded (And φ ψ) = (future_bounded φ  future_bounded ψ)"
| "future_bounded (Ands l) = list_all future_bounded l"
| "future_bounded (Exists φ) = future_bounded φ"
| "future_bounded (Agg y ω b f φ) = future_bounded φ"
| "future_bounded (Prev I φ) = future_bounded φ"
| "future_bounded (Next I φ) = future_bounded φ"
| "future_bounded (Since φ I ψ) = (future_bounded φ  future_bounded ψ)"
| "future_bounded (Until φ I ψ) = (future_bounded φ  future_bounded ψ  right I  )"
| "future_bounded (MatchP I r) = Regex.pred_regex future_bounded r"
| "future_bounded (MatchF I r) = (Regex.pred_regex future_bounded r  right I  )"


subsubsection ‹Semantics›

definition "ecard A = (if finite A then card A else )"

qualified fun sat :: "trace  (name  nat  event_data list set)  env  nat  formula  bool" where
  "sat σ V v i (Pred r ts) = (case V r of
       None  (r, map (eval_trm v) ts)  Γ σ i
     | Some X  map (eval_trm v) ts  X i)"
| "sat σ V v i (Let p φ ψ) =
    sat σ (V(p  λi. {v. length v = nfv φ  sat σ V v i φ})) v i ψ"
| "sat σ V v i (Eq t1 t2) = (eval_trm v t1 = eval_trm v t2)"
| "sat σ V v i (Less t1 t2) = (eval_trm v t1 < eval_trm v t2)"
| "sat σ V v i (LessEq t1 t2) = (eval_trm v t1  eval_trm v t2)"
| "sat σ V v i (Neg φ) = (¬ sat σ V v i φ)"
| "sat σ V v i (Or φ ψ) = (sat σ V v i φ  sat σ V v i ψ)"
| "sat σ V v i (And φ ψ) = (sat σ V v i φ  sat σ V v i ψ)"
| "sat σ V v i (Ands l) = (φ  set l. sat σ V v i φ)"
| "sat σ V v i (Exists φ) = (z. sat σ V (z # v) i φ)"
| "sat σ V v i (Agg y ω b f φ) =
    (let M = {(x, ecard Zs) | x Zs. Zs = {zs. length zs = b  sat σ V (zs @ v) i φ  eval_trm (zs @ v) f = x}  Zs  {}}
    in (M = {}  fv φ  {0..<b})  v ! y = eval_agg_op ω M)"
| "sat σ V v i (Prev I φ) = (case i of 0  False | Suc j  mem (τ σ i - τ σ j) I  sat σ V v j φ)"
| "sat σ V v i (Next I φ) = (mem (τ σ (Suc i) - τ σ i) I  sat σ V v (Suc i) φ)"
| "sat σ V v i (Since φ I ψ) = (ji. mem (τ σ i - τ σ j) I  sat σ V v j ψ  (k  {j <.. i}. sat σ V v k φ))"
| "sat σ V v i (Until φ I ψ) = (ji. mem (τ σ j - τ σ i) I  sat σ V v j ψ  (k  {i ..< j}. sat σ V v k φ))"
| "sat σ V v i (MatchP I r) = (ji. mem (τ σ i - τ σ j) I  Regex.match (sat σ V v) r j i)"
| "sat σ V v i (MatchF I r) = (ji. mem (τ σ j - τ σ i) I  Regex.match (sat σ V v) r i j)"

lemma sat_abbrevs[simp]:
  "sat σ V v i TT" "¬ sat σ V v i FF"
  unfolding TT_def FF_def by auto

lemma sat_Ands: "sat σ V v i (Ands l)  (φset l. sat σ V v i φ)"
  by (simp add: list_all_iff)

lemma sat_Until_rec: "sat σ V v i (Until φ I ψ) 
  mem 0 I  sat σ V v i ψ 
  (Δ σ (i + 1)  right I  sat σ V v i φ  sat σ V v (i + 1) (Until φ (subtract (Δ σ (i + 1)) I) ψ))"
  (is "?L  ?R")
proof (rule iffI; (elim disjE conjE)?)
  assume ?L
  then obtain j where j: "i  j" "mem (τ σ j - τ σ i) I" "sat σ V v j ψ" "k  {i ..< j}. sat σ V v k φ"
    by auto
  then show ?R
  proof (cases "i = j")
    case False
    with j(1,2) have σ (i + 1)  right I"
      by (auto elim: order_trans[rotated] simp: diff_le_mono)
    moreover from False j(1,4) have "sat σ V v i φ" by auto
    moreover from False j have "sat σ V v (i + 1) (Until φ (subtract (Δ σ (i + 1)) I) ψ)"
      by (cases "right I") (auto simp: le_diff_conv le_diff_conv2 intro!: exI[of _ j])
    ultimately show ?thesis by blast
  qed simp
next
  assume Δ: σ (i + 1)  right I" and now: "sat σ V v i φ" and
   "next": "sat σ V v (i + 1) (Until φ (subtract (Δ σ (i + 1)) I) ψ)"
  from "next" obtain j where j: "i + 1  j" "mem (τ σ j - τ σ (i + 1)) ((subtract (Δ σ (i + 1)) I))"
      "sat σ V v j ψ" "k  {i + 1 ..< j}. sat σ V v k φ"
    by auto
  from Δ j(1,2) have "mem (τ σ j - τ σ i) I"
    by (cases "right I") (auto simp: le_diff_conv2)
  with now j(1,3,4) show ?L by (auto simp: le_eq_less_or_eq[of i] intro!: exI[of _ j])
qed auto

lemma sat_Since_rec: "sat σ V v i (Since φ I ψ) 
  mem 0 I  sat σ V v i ψ 
  (i > 0  Δ σ i  right I  sat σ V v i φ  sat σ V v (i - 1) (Since φ (subtract (Δ σ i) I) ψ))"
  (is "?L  ?R")
proof (rule iffI; (elim disjE conjE)?)
  assume ?L
  then obtain j where j: "j  i" "mem (τ σ i - τ σ j) I" "sat σ V v j ψ" "k  {j <.. i}. sat σ V v k φ"
    by auto
  then show ?R
  proof (cases "i = j")
    case False
    with j(1) obtain k where [simp]: "i = k + 1"
      by (cases i) auto
    with j(1,2) False have σ i  right I"
      by (auto elim: order_trans[rotated] simp: diff_le_mono2 le_Suc_eq)
    moreover from False j(1,4) have "sat σ V v i φ" by auto
    moreover from False j have "sat σ V v (i - 1) (Since φ (subtract (Δ σ i) I) ψ)"
      by (cases "right I") (auto simp: le_diff_conv le_diff_conv2 intro!: exI[of _ j])
    ultimately show ?thesis by auto
  qed simp
next
  assume i: "0 < i" and Δ: σ i  right I" and now: "sat σ V v i φ" and
   "prev": "sat σ V v (i - 1) (Since φ (subtract (Δ σ i) I) ψ)"
  from "prev" obtain j where j: "j  i - 1" "mem (τ σ (i - 1) - τ σ j) ((subtract (Δ σ i) I))"
      "sat σ V v j ψ" "k  {j <.. i - 1}. sat σ V v k φ"
    by auto
  from Δ i j(1,2) have "mem (τ σ i - τ σ j) I"
    by (cases "right I") (auto simp: le_diff_conv2)
  with now i j(1,3,4) show ?L by (auto simp: le_Suc_eq gr0_conv_Suc intro!: exI[of _ j])
qed auto

lemma sat_MatchF_rec: "sat σ V v i (MatchF I r)  mem 0 I  Regex.eps (sat σ V v) i r 
  Δ σ (i + 1)  right I  (s  Regex.lpd (sat σ V v) i r. sat σ V v (i + 1) (MatchF (subtract (Δ σ (i + 1)) I) s))"
  (is "?L  ?R1  ?R2")
proof (rule iffI; (elim disjE conjE bexE)?)
  assume ?L
  then obtain j where j: "j  i" "mem (τ σ j - τ σ i) I" and "Regex.match (sat σ V v) r i j" by auto
  then show "?R1  ?R2"
  proof (cases "i < j")
    case True
    with ‹Regex.match (sat σ V v) r i j lpd_match[of i j "sat σ V v" r]
    obtain s where "s  Regex.lpd (sat σ V v) i r" "Regex.match (sat σ V v) s (i + 1) j" by auto
    with True j have ?R2
      by (cases "right I")
        (auto simp: le_diff_conv le_diff_conv2 intro!: exI[of _ j] elim: le_trans[rotated])
    then show ?thesis by blast
  qed (auto simp: eps_match)
next
  assume "enat (Δ σ (i + 1))  right I"
  moreover
  fix s
  assume [simp]: "s  Regex.lpd (sat σ V v) i r" and "sat σ V v (i + 1) (MatchF (subtract (Δ σ (i + 1)) I) s)"
  then obtain j where "j > i" "Regex.match (sat σ V v) s (i + 1) j"
    "mem (τ σ j - τ σ (Suc i)) (subtract (Δ σ (i + 1)) I)" by (auto simp: Suc_le_eq)
  ultimately show ?L
    by (cases "right I")
      (auto simp: le_diff_conv lpd_match intro!: exI[of _ j] bexI[of _ s])
qed (auto simp: eps_match intro!: exI[of _ i])

lemma sat_MatchP_rec: "sat σ V v i (MatchP I r)  mem 0 I  Regex.eps (sat σ V v) i r 
  i > 0  Δ σ i  right I  (s  Regex.rpd (sat σ V v) i r. sat σ V v (i - 1) (MatchP (subtract (Δ σ i) I) s))"
  (is "?L  ?R1  ?R2")
proof (rule iffI; (elim disjE conjE bexE)?)
  assume ?L
  then obtain j where j: "j  i" "mem (τ σ i - τ σ j) I" and "Regex.match (sat σ V v) r j i" by auto
  then show "?R1  ?R2"
  proof (cases "j < i")
    case True
    with ‹Regex.match (sat σ V v) r j i rpd_match[of j i "sat σ V v" r]
    obtain s where "s  Regex.rpd (sat σ V v) i r" "Regex.match (sat σ V v) s j (i - 1)" by auto
    with True j have ?R2
      by (cases "right I")
        (auto simp: le_diff_conv le_diff_conv2 intro!: exI[of _ j] elim: le_trans)
    then show ?thesis by blast
  qed (auto simp: eps_match)
next
  assume "enat (Δ σ i)  right I"
  moreover
  fix s
  assume [simp]: "s  Regex.rpd (sat σ V v) i r" and "sat σ V v (i - 1) (MatchP (subtract (Δ σ i) I) s)" "i > 0"
  then obtain j where "j < i" "Regex.match (sat σ V v) s j (i - 1)"
    "mem (τ σ (i - 1) - τ σ j) (subtract (Δ σ i) I)" by (auto simp: gr0_conv_Suc less_Suc_eq_le)
  ultimately show ?L
    by (cases "right I")
      (auto simp: le_diff_conv rpd_match intro!: exI[of _ j] bexI[of _ s])
qed (auto simp: eps_match intro!: exI[of _ i])

lemma sat_Since_0: "sat σ V v 0 (Since φ I ψ)  mem 0 I  sat σ V v 0 ψ"
  by auto

lemma sat_MatchP_0: "sat σ V v 0 (MatchP I r)  mem 0 I  Regex.eps (sat σ V v) 0 r"
  by (auto simp: eps_match)

lemma sat_Since_point: "sat σ V v i (Since φ I ψ) 
    (j. j  i  mem (τ σ i - τ σ j) I  sat σ V v i (Since φ (point (τ σ i - τ σ j)) ψ)  P)  P"
  by (auto intro: diff_le_self)

lemma sat_MatchP_point: "sat σ V v i (MatchP I r) 
    (j. j  i  mem (τ σ i - τ σ j) I  sat σ V v i (MatchP (point (τ σ i - τ σ j)) r)  P)  P"
  by (auto intro: diff_le_self)

lemma sat_Since_pointD: "sat σ V v i (Since φ (point t) ψ)  mem t I  sat σ V v i (Since φ I ψ)"
  by auto

lemma sat_MatchP_pointD: "sat σ V v i (MatchP (point t) r)  mem t I  sat σ V v i (MatchP I r)"
  by auto

lemma sat_fv_cong: "xfv φ. v!x = v'!x  sat σ V v i φ = sat σ V v' i φ"
proof (induct φ arbitrary: V v v' i rule: formula.induct)
  case (Pred n ts)
  show ?case by (simp cong: map_cong eval_trm_fv_cong[OF Pred[simplified, THEN bspec]] split: option.splits)
next
  case (Let p b φ ψ)
  then show ?case
    by auto
next
  case (Eq x1 x2)
  then show ?case unfolding fvi.simps sat.simps by (metis UnCI eval_trm_fv_cong)
next
  case (Less x1 x2)
  then show ?case unfolding fvi.simps sat.simps by (metis UnCI eval_trm_fv_cong)
next
  case (LessEq x1 x2)
  then show ?case unfolding fvi.simps sat.simps by (metis UnCI eval_trm_fv_cong)
next
  case (Ands l)
  have "φ. φ  set l  sat σ V v i φ = sat σ V v' i φ"
  proof -
    fix φ assume "φ  set l"
    then have "fv φ  fv (Ands l)" using fv_subset_Ands by blast
    then have "xfv φ. v!x = v'!x" using Ands.prems by blast
    then show "sat σ V v i φ = sat σ V v' i φ" using Ands.hyps φ  set l by blast
  qed
  then show ?case using sat_Ands by blast
next
  case (Exists φ)
  then show ?case unfolding sat.simps by (intro iff_exI) (simp add: fvi_Suc nth_Cons')
next
  case (Agg y ω b f φ)
  have "v ! y = v' ! y"
    using Agg.prems by simp
  moreover have "sat σ V (zs @ v) i φ = sat σ V (zs @ v') i φ" if "length zs = b" for zs
    using that Agg.prems by (simp add: Agg.hyps[where v="zs @ v" and v'="zs @ v'"]
        nth_append fvi_iff_fv(1)[where b=b])
  moreover have "eval_trm (zs @ v) f = eval_trm (zs @ v') f" if "length zs = b" for zs
    using that Agg.prems by (auto intro!: eval_trm_fv_cong[where v="zs @ v" and v'="zs @ v'"]
        simp: nth_append fvi_iff_fv(1)[where b=b] fvi_trm_iff_fv_trm[where b="length zs"])
  ultimately show ?case
    by (simp cong: conj_cong)
next
  case (MatchF I r)
  then have "Regex.match (sat σ V v) r = Regex.match (sat σ V v') r"
    by (intro match_fv_cong) (auto simp: fv_regex_alt)
  then show ?case
    by auto
next
  case (MatchP I r)
  then have "Regex.match (sat σ V v) r = Regex.match (sat σ V v') r"
    by (intro match_fv_cong) (auto simp: fv_regex_alt)
  then show ?case
    by auto
qed (auto 10 0 split: nat.splits intro!: iff_exI)

lemma match_fv_cong:
  "xfv_regex r. v!x = v'!x  Regex.match (sat σ V v) r = Regex.match (sat σ V v') r"
  by (rule match_fv_cong, rule sat_fv_cong) (auto simp: fv_regex_alt)

lemma eps_fv_cong:
  "xfv_regex r. v!x = v'!x  Regex.eps (sat σ V v) i r = Regex.eps (sat σ V v') i r"
  unfolding eps_match by (erule match_fv_cong[THEN fun_cong, THEN fun_cong])


subsection ‹Past-only formulas›

fun past_only :: "formula  bool" where
  "past_only (Pred _ _) = True"
| "past_only (Eq _ _) = True"
| "past_only (Less _ _) = True"
| "past_only (LessEq _ _) = True"
| "past_only (Let _ α β) = (past_only α  past_only β)"
| "past_only (Neg ψ) = past_only ψ"
| "past_only (Or α β) = (past_only α  past_only β)"
| "past_only (And α β) = (past_only α  past_only β)"
| "past_only (Ands l) = (αset l. past_only α)"
| "past_only (Exists ψ) = past_only ψ"
| "past_only (Agg _ _ _ _ ψ) = past_only ψ"
| "past_only (Prev _ ψ) = past_only ψ"
| "past_only (Next _ _) = False"
| "past_only (Since α _ β) = (past_only α  past_only β)"
| "past_only (Until α _ β) = False"
| "past_only (MatchP _ r) = Regex.pred_regex past_only r"
| "past_only (MatchF _ _) = False"

lemma past_only_sat:
  assumes "prefix_of π σ" "prefix_of π σ'"
  shows "i < plen π  dom V = dom V' 
     (p i. p  dom V  i < plen π  the (V p) i = the (V' p) i) 
     past_only φ  sat σ V v i φ = sat σ' V' v i φ"
proof (induction φ arbitrary: V V' v i)
  case (Pred e ts)
  show ?case proof (cases "V e")
    case None
    then have "V' e = None" using ‹dom V = dom V' by auto
    with None Γ_prefix_conv[OF assms(1,2) Pred(1)] show ?thesis by simp
  next
    case (Some a)
    moreover obtain a' where "V' e = Some a'" using Some ‹dom V = dom V' by auto
    moreover have "the (V e) i = the (V' e) i"
      using Some Pred(1,3) by (fastforce intro: domI)
    ultimately show ?thesis by simp
  qed
next
  case (Let p φ ψ)
  let ?V = "λV σ. (V(p  λi. {v. length v = nfv φ  sat σ V v i φ}))"
  show ?case unfolding sat.simps proof (rule Let.IH(2))
    show "i < plen π" by fact
    from Let.prems show "past_only ψ" by simp
    from Let.prems show "dom (?V V σ) = dom (?V V' σ')"
      by (simp del: fun_upd_apply)
  next
    fix p' i
    assume *: "p'  dom (?V V σ)" "i < plen π"
    show "the (?V V σ p') i = the (?V V' σ' p') i" proof (cases "p' = p")
      case True
      with Let i < plen π show ?thesis by auto
    next
      case False
      with * show ?thesis by (auto intro!: Let.prems(3))
    qed
  qed
next
  case (Ands l)
  with Γ_prefix_conv[OF assms] show ?case by simp
next
  case (Prev I φ)
  with τ_prefix_conv[OF assms] show ?case by (simp split: nat.split)
next
  case (Since φ1 I φ2)
  with τ_prefix_conv[OF assms] show ?case by auto
next
  case (MatchP I r)
  then have "Regex.match (sat σ V v) r a b = Regex.match (sat σ' V' v) r a b" if "b < plen π" for a b
    using that by (intro Regex.match_cong_strong) (auto simp: regex.pred_set)
  with τ_prefix_conv[OF assms] MatchP(2) show ?case by auto
qed auto


subsection ‹Safe formulas›

fun remove_neg :: "formula  formula" where
  "remove_neg (Neg φ) = φ"
| "remove_neg φ = φ"

lemma fvi_remove_neg[simp]: "fvi b (remove_neg φ) = fvi b φ"
  by (cases φ) simp_all

lemma partition_cong[fundef_cong]:
  "xs = ys  (x. xset xs  f x = g x)  partition f xs = partition g ys"
  by (induction xs arbitrary: ys) auto

lemma size_remove_neg[termination_simp]: "size (remove_neg φ)  size φ"
  by (cases φ) simp_all

fun is_constraint :: "formula  bool" where
  "is_constraint (Eq t1 t2) = True"
| "is_constraint (Less t1 t2) = True"
| "is_constraint (LessEq t1 t2) = True"
| "is_constraint (Neg (Eq t1 t2)) = True"
| "is_constraint (Neg (Less t1 t2)) = True"
| "is_constraint (Neg (LessEq t1 t2)) = True"
| "is_constraint _ = False"

definition safe_assignment :: "nat set  formula  bool" where
  "safe_assignment X φ = (case φ of
       Eq (Var x) (Var y)  (x  X  y  X)
     | Eq (Var x) t  (x  X  fv_trm t  X)
     | Eq t (Var x)  (x  X  fv_trm t  X)
     | _  False)"

fun safe_formula :: "formula  bool" where
  "safe_formula (Eq t1 t2) = (is_Const t1  (is_Const t2  is_Var t2)  is_Var t1  is_Const t2)"
| "safe_formula (Neg (Eq (Var x) (Var y))) = (x = y)"
| "safe_formula (Less t1 t2) = False"
| "safe_formula (LessEq t1 t2) = False"
| "safe_formula (Pred e ts) = (tset ts. is_Var t  is_Const t)"
| "safe_formula (Let p φ ψ) = ({0..<nfv φ}  fv φ  safe_formula φ  safe_formula ψ)"
| "safe_formula (Neg φ) = (fv φ = {}  safe_formula φ)"
| "safe_formula (Or φ ψ) = (fv ψ = fv φ  safe_formula φ  safe_formula ψ)"
| "safe_formula (And φ ψ) = (safe_formula φ 
    (safe_assignment (fv φ) ψ  safe_formula ψ 
      fv ψ  fv φ  (is_constraint ψ  (case ψ of Neg ψ'  safe_formula ψ' | _  False))))"
| "safe_formula (Ands l) = (let (pos, neg) = partition safe_formula l in pos  [] 
    list_all safe_formula (map remove_neg neg)  (set (map fv neg))  (set (map fv pos)))"
| "safe_formula (Exists φ) = (safe_formula φ)"
| "safe_formula (Agg y ω b f φ) = (safe_formula φ  y + b  fv φ  {0..<b}  fv φ  fv_trm f  fv φ)"
| "safe_formula (Prev I φ) = (safe_formula φ)"
| "safe_formula (Next I φ) = (safe_formula φ)"
| "safe_formula (Since φ I ψ) = (fv φ  fv ψ 
    (safe_formula φ  (case φ of Neg φ'  safe_formula φ' | _  False))  safe_formula ψ)"
| "safe_formula (Until φ I ψ) = (fv φ  fv ψ 
    (safe_formula φ  (case φ of Neg φ'  safe_formula φ' | _  False))  safe_formula ψ)"
| "safe_formula (MatchP I r) = Regex.safe_regex fv (λg φ. safe_formula φ 
     (g = Lax  (case φ of Neg φ'  safe_formula φ' | _  False))) Past Strict r"
| "safe_formula (MatchF I r) = Regex.safe_regex fv (λg φ. safe_formula φ 
     (g = Lax  (case φ of Neg φ'  safe_formula φ' | _  False))) Futu Strict r"

abbreviation "safe_regex  Regex.safe_regex fv (λg φ. safe_formula φ 
  (g = Lax  (case φ of Neg φ'  safe_formula φ' | _  False)))"

lemma safe_regex_safe_formula:
  "safe_regex m g r  φ  Regex.atms r  safe_formula φ 
  (ψ. φ = Neg ψ  safe_formula ψ)"
  by (cases g) (auto dest!: safe_regex_safe[rotated] split: formula.splits[where formula=φ])

lemma safe_abbrevs[simp]: "safe_formula TT" "safe_formula FF"
  unfolding TT_def FF_def by auto

definition safe_neg :: "formula  bool" where
  "safe_neg φ  (¬ safe_formula φ  safe_formula (remove_neg φ))"

definition atms :: "formula Regex.regex  formula set" where
  "atms r = (φ  Regex.atms r.
     if safe_formula φ then {φ} else case φ of Neg φ'  {φ'} | _  {})"

lemma atms_simps[simp]:
  "atms (Regex.Skip n) = {}"
  "atms (Regex.Test φ) = (if safe_formula φ then {φ} else case φ of Neg φ'  {φ'} | _  {})"
  "atms (Regex.Plus r s) = atms r  atms s"
  "atms (Regex.Times r s) = atms r  atms s"
  "atms (Regex.Star r) = atms r"
  unfolding atms_def by auto

lemma finite_atms[simp]: "finite (atms r)"
  by (induct r) (auto split: formula.splits)

lemma disjE_Not2: "P  Q  (P  R)  (¬P  Q  R)  R"
  by blast

lemma safe_formula_induct[consumes 1, case_names Eq_Const Eq_Var1 Eq_Var2 neq_Var Pred Let
    And_assign And_safe And_constraint And_Not Ands Neg Or Exists Agg
    Prev Next Since Not_Since Until Not_Until MatchP MatchF]:
  assumes "safe_formula φ"
    and Eq_Const: "c d. P (Eq (Const c) (Const d))"
    and Eq_Var1: "c x. P (Eq (Const c) (Var x))"
    and Eq_Var2: "c x. P (Eq (Var x) (Const c))"
    and neq_Var: "x. P (Neg (Eq (Var x) (Var x)))"
    and Pred: "e ts. tset ts. is_Var t  is_Const t  P (Pred e ts)"
    and Let: "p φ ψ. {0..<nfv φ}  fv φ  safe_formula φ  safe_formula ψ  P φ  P ψ  P (Let p φ ψ)"
    and And_assign: "φ ψ. safe_formula φ  safe_assignment (fv φ) ψ  P φ  P (And φ ψ)"
    and And_safe: "φ ψ. safe_formula φ  ¬ safe_assignment (fv φ) ψ  safe_formula ψ 
      P φ  P ψ  P (And φ ψ)"
    and And_constraint: "φ ψ. safe_formula φ  ¬ safe_assignment (fv φ) ψ  ¬ safe_formula ψ 
      fv ψ  fv φ  is_constraint ψ  P φ  P (And φ ψ)"
    and And_Not: "φ ψ. safe_formula φ  ¬ safe_assignment (fv φ) (Neg ψ)  ¬ safe_formula (Neg ψ) 
      fv (Neg ψ)  fv φ  ¬ is_constraint (Neg ψ)  safe_formula ψ  P φ  P ψ  P (And φ (Neg ψ))"
    and Ands: "l pos neg. (pos, neg) = partition safe_formula l  pos  [] 
      list_all safe_formula pos  list_all safe_formula (map remove_neg neg) 
      (φset neg. fv φ)  (φset pos. fv φ) 
      list_all P pos  list_all P (map remove_neg neg)  P (Ands l)"
    and Neg: "φ. fv φ = {}  safe_formula φ  P φ  P (Neg φ)"
    and Or: "φ ψ. fv ψ = fv φ  safe_formula φ  safe_formula ψ  P φ  P ψ  P (Or φ ψ)"
    and Exists: "φ. safe_formula φ  P φ  P (Exists φ)"
    and Agg: "y ω b f φ. y + b  fv φ  {0..<b}  fv φ  fv_trm f  fv φ 
      safe_formula φ  P φ  P (Agg y ω b f φ)"
    and Prev: "I φ. safe_formula φ  P φ  P (Prev I φ)"
    and Next: "I φ. safe_formula φ  P φ  P (Next I φ)"
    and Since: "φ I ψ. fv φ  fv ψ  safe_formula φ  safe_formula ψ  P φ  P ψ  P (Since φ I ψ)"
    and Not_Since: "φ I ψ. fv (Neg φ)  fv ψ  safe_formula φ 
      ¬ safe_formula (Neg φ)  safe_formula ψ  P φ  P ψ  P (Since (Neg φ) I ψ )"
    and Until: "φ I ψ. fv φ  fv ψ  safe_formula φ  safe_formula ψ  P φ  P ψ  P (Until φ I ψ)"
    and Not_Until: "φ I ψ. fv (Neg φ)  fv ψ  safe_formula φ 
      ¬ safe_formula (Neg φ)  safe_formula ψ  P φ  P ψ  P (Until (Neg φ) I ψ)"
    and MatchP: "I r. safe_regex Past Strict r  φ  atms r. P φ  P (MatchP I r)"
    and MatchF: "I r. safe_regex Futu Strict r  φ  atms r. P φ  P (MatchF I r)"
  shows "P φ"
using assms(1) proof (induction φ rule: safe_formula.induct)
  case (1 t1 t2)
  then show ?case using Eq_Const Eq_Var1 Eq_Var2 by (auto simp: trm.is_Const_def trm.is_Var_def)
next
  case (9 φ ψ)
  from ‹safe_formula (And φ ψ) have "safe_formula φ" by simp
  from ‹safe_formula (And φ ψ) consider
    (a) "safe_assignment (fv φ) ψ"
    | (b) "¬ safe_assignment (fv φ) ψ" "safe_formula ψ"
    | (c) "fv ψ  fv φ" "¬ safe_assignment (fv φ) ψ" "¬ safe_formula ψ" "is_constraint ψ"
    | (d) ψ' where "fv ψ  fv φ" "¬ safe_assignment (fv φ) ψ" "¬ safe_formula ψ" "¬ is_constraint ψ"
        "ψ = Neg ψ'" "safe_formula ψ'"
    by (cases ψ) auto
  then show ?case proof cases
    case a
    then show ?thesis using "9.IH" ‹safe_formula φ by (intro And_assign)
  next
    case b
    then show ?thesis using "9.IH" ‹safe_formula φ by (intro And_safe)
  next
    case c
    then show ?thesis using "9.IH" ‹safe_formula φ by (intro And_constraint)
  next
    case d
    then show ?thesis using "9.IH" ‹safe_formula φ by (blast intro!: And_Not)
  qed
next
  case (10 l)
  obtain pos neg where posneg: "(pos, neg) = partition safe_formula l" by simp
  have "pos  []" using "10.prems" posneg by simp
  moreover have "list_all safe_formula pos" using posneg by (simp add: list.pred_set)
  moreover have safe_remove_neg: "list_all safe_formula (map remove_neg neg)" using "10.prems" posneg by auto
  moreover have "list_all P pos"
    using posneg "10.IH"(1) by (simp add: list_all_iff)
  moreover have "list_all P (map remove_neg neg)"
    using "10.IH"(2)[OF posneg] safe_remove_neg by (simp add: list_all_iff)
  ultimately show ?case using "10.IH"(1) "10.prems" Ands posneg by simp
next
  case (15 φ I ψ)
  then show ?case
  proof (cases φ)
    case (Ands l)
    then show ?thesis using "15.IH"(1) "15.IH"(3) "15.prems" Since by auto
  qed (auto 0 3 elim!: disjE_Not2 intro: Since Not_Since) (*SLOW*)
next
  case (16 φ I ψ)
  then show ?case
  proof (cases φ)
    case (Ands l)
    then show ?thesis using "16.IH"(1) "16.IH"(3) "16.prems" Until by auto
  qed (auto 0 3 elim!: disjE_Not2 intro: Until Not_Until) (*SLOW*)
next
  case (17 I r)
  then show ?case
    by (intro MatchP) (auto simp: atms_def dest: safe_regex_safe_formula split: if_splits)
next
  case (18 I r)
  then show ?case
    by (intro MatchF) (auto simp: atms_def dest: safe_regex_safe_formula split: if_splits)
qed (auto simp: assms)

lemma safe_formula_NegD:
  "safe_formula (Formula.Neg φ)  fv φ = {}  (x. φ = Formula.Eq (Formula.Var x) (Formula.Var x))"
  by (induct "Formula.Neg φ" rule: safe_formula_induct) auto


subsection ‹Slicing traces›

qualified fun matches ::
  "env  formula  name × event_data list  bool" where
  "matches v (Pred r ts) e = (fst e = r  map (eval_trm v) ts = snd e)"
| "matches v (Let p φ ψ) e =
    ((v'. matches v' φ e  matches v ψ (p, v')) 
    fst e  p  matches v ψ e)"
| "matches v (Eq _ _) e = False"
| "matches v (Less _ _) e = False"
| "matches v (LessEq _ _) e = False"
| "matches v (Neg φ) e = matches v φ e"
| "matches v (Or φ ψ) e = (matches v φ e  matches v ψ e)"
| "matches v (And φ ψ) e = (matches v φ e  matches v ψ e)"
| "matches v (Ands l) e = (φset l. matches v φ e)"
| "matches v (Exists φ) e = (z. matches (z # v) φ e)"
| "matches v (Agg y ω b f φ) e = (zs. length zs = b  matches (zs @ v) φ e)"
| "matches v (Prev I φ) e = matches v φ e"
| "matches v (Next I φ) e = matches v φ e"
| "matches v (Since φ I ψ) e = (matches v φ e  matches v ψ e)"
| "matches v (Until φ I ψ) e = (matches v φ e  matches v ψ e)"
| "matches v (MatchP I r) e = (φ  Regex.atms r. matches v φ e)"
| "matches v (MatchF I r) e = (φ  Regex.atms r. matches v φ e)"

lemma matches_cong:
  "xfv φ. v!x = v'!x  matches v φ e = matches v' φ e"
proof (induct φ arbitrary: v v' e)
  case (Pred n ts)
  show ?case
    by (simp cong: map_cong eval_trm_fv_cong[OF Pred(1)[simplified, THEN bspec]])
next
  case (Let p b φ ψ)
  then show ?case
    by (cases e) (auto 11 0)
next
  case (Ands l)
  have "φ. φ  (set l)  matches v φ e = matches v' φ e"
  proof -
    fix φ assume "φ  (set l)"
    then have "fv φ  fv (Ands l)" using fv_subset_Ands by blast
    then have "xfv φ. v!x = v'!x" using Ands.prems by blast
    then show "matches v φ e = matches v' φ e" using Ands.hyps φ  set l by blast
  qed
  then show ?case by simp
next
  case (Exists φ)
  then show ?case unfolding matches.simps by (intro iff_exI) (simp add: fvi_Suc nth_Cons')
next
  case (Agg y ω b f φ)
  have "matches (zs @ v) φ e = matches (zs @ v') φ e" if "length zs = b" for zs
    using that Agg.prems by (simp add: Agg.hyps[where v="zs @ v" and v'="zs @ v'"]
        nth_append fvi_iff_fv(1)[where b=b])
  then show ?case by auto
qed (auto 9 0 simp add: nth_Cons' fv_regex_alt)

abbreviation relevant_events where "relevant_events φ S  {e. S  {v. matches v φ e}  {}}"

lemma sat_slice_strong:
  assumes "v  S" "dom V = dom V'"
    "p v i. p  dom V  (p, v)  relevant_events φ S  v  the (V p) i  v  the (V' p) i"
  shows "relevant_events φ S - {e. fst e  dom V}  E 
    sat σ V v i φ  sat (map_Γ (λD. D  E) σ) V' v i φ"
  using assms
proof (induction φ arbitrary: V V' v S i)
  case (Pred r ts)
  show ?case proof (cases "V r")
    case None
    then have "V' r = None" using ‹dom V = dom V' by auto
    with None Pred(1,2) show ?thesis by (auto simp: domIff dest!: subsetD)
  next
    case (Some a)
    moreover obtain a' where "V' r = Some a'" using Some ‹dom V = dom V' by auto
    moreover have "(map (eval_trm v) ts  the (V r) i) = (map (eval_trm v) ts  the (V' r) i)"
      using Some Pred(2,4) by (fastforce intro: domI)
    ultimately show ?thesis by simp
  qed
next
  case (Let p φ ψ)
  from Let.prems show ?case unfolding sat.simps
  proof (intro Let(2)[of S], goal_cases relevant v dom V)
    case (V p' v' i)
    then show ?case
    proof (cases "p' = p")
      case [simp]: True
      with V show ?thesis
        unfolding fun_upd_apply eqTrueI[OF True] if_True option.sel mem_Collect_eq
      proof (intro ex_cong conj_cong refl Let(1)[where
        S="{v'. (v  S. matches v ψ (p, v'))}" and V=V],
        goal_cases relevant' v' dom' V')
        case relevant'
        then show ?case
          by (elim subset_trans[rotated]) (auto simp: set_eq_iff)
      next
        case (V' p' v' i)
        then show ?case
          by (intro V(4)) (auto simp: set_eq_iff)
      qed auto
    next
      case False
      with V(2,3,5,6) show ?thesis
        unfolding fun_upd_apply eq_False[THEN iffD2, OF False] if_False
        by (intro V(4)) (auto simp: False)
    qed
  qed (auto simp: dom_def)
next
  case (Or φ ψ)
  show ?case using Or.IH[of S V v V'] Or.prems
    by (auto simp: Collect_disj_eq Int_Un_distrib subset_iff)
next
  case (And φ ψ)
  show ?case using And.IH[of S V v V'] And.prems
    by (auto simp: Collect_disj_eq Int_Un_distrib subset_iff)
next
  case (Ands l)
  obtain "relevant_events (Ands l) S - {e. fst e  dom V}  E" "v  S" using Ands.prems(1) Ands.prems(2) by blast
  then have "{e. S  {v. matches v (Ands l) e}  {}} - {e. fst e  dom V}  E" by simp
  have "φ. φ  set l  sat σ V v i φ  sat (map_Γ (λD. D  E) σ) V' v i φ"
  proof -
    fix φ assume "φ  set l"
    have "relevant_events φ S = {e. S  {v. matches v φ e}  {}}" by simp
    have "{e. S  {v. matches v φ e}  {}}  {e. S  {v. matches v (Ands l) e}  {}}" (is "?A  ?B")
    proof (rule subsetI)
      fix e assume "e  ?A"
      then have "S  {v. matches v φ e}  {}" by blast
      moreover have "S  {v. matches v (Ands l) e}  {}"
      proof -
        obtain v where "v  S" "matches v φ e" using calculation by blast
        then show ?thesis using φ  set l by auto
      qed
      then show "e  ?B" by blast
    qed
    then have "relevant_events φ S - {e. fst e  dom V}  E" using Ands.prems(1) by auto
    then show "sat σ V v i φ  sat (map_Γ (λD. D  E) σ) V' v i φ"
      using Ands.prems(2,3) φ  set l
      by (intro Ands.IH[of φ S V v V' i] Ands.prems(4)) auto
  qed
  show ?case using φ. φ  set l  sat σ V v i φ = sat (map_Γ (λD. D  E) σ) V' v i φ sat_Ands by blast
next
  case (Exists φ)
  have "sat σ V (z # v) i φ = sat (map_Γ (λD. D  E) σ) V' (z # v) i φ" for z
    using Exists.prems(1-3) by (intro Exists.IH[where S="{z # v | v. v  S}"] Exists.prems(4)) auto
  then show ?case by simp
next
  case (Agg y ω b f φ)
  have "sat σ V (zs @ v) i φ = sat (map_Γ (λD. D  E) σ) V' (zs @ v) i φ" if "length zs = b" for zs
    using that Agg.prems(1-3) by (intro Agg.IH[where S="{zs @ v | v. v  S}"] Agg.prems(4)) auto
  then show ?case by (simp cong: conj_cong)
next
  case (Prev I φ)
  then show ?case by (auto cong: nat.case_cong)
next
  case (Next I φ)
  then show ?case by simp
next
  case (Since φ I ψ)
  show ?case using Since.IH[of S V] Since.prems
   by (auto simp: Collect_disj_eq Int_Un_distrib subset_iff)
next
  case (Until φ I ψ)
  show ?case using Until.IH[of S V] Until.prems
    by (auto simp: Collect_disj_eq Int_Un_distrib subset_iff)
next
  case (MatchP I r)
  from MatchP.prems(1-3) have "Regex.match (sat σ V v) r = Regex.match (sat (map_Γ (λD. D  E) σ) V' v) r"
    by (intro Regex.match_fv_cong MatchP(1)[of _ S V v] MatchP.prems(4)) auto
  then show ?case
    by auto
next
  case (MatchF I r)
  from MatchF.prems(1-3) have "Regex.match (sat σ V v) r = Regex.match (sat (map_Γ (λD. D  E) σ) V' v) r"
    by (intro Regex.match_fv_cong MatchF(1)[of _ S V v] MatchF.prems(4)) auto
  then show ?case
    by auto
qed simp_all


subsection ‹Translation to n-ary conjunction›

fun get_and_list :: "formula  formula list" where
  "get_and_list (Ands l) = l"
| "get_and_list φ = [φ]"

lemma fv_get_and: "(x(set (get_and_list φ)). fvi b x) = fvi b φ"
  by (induction φ rule: get_and_list.induct) simp_all

lemma safe_get_and: "safe_formula φ  list_all safe_neg (get_and_list φ)"
  by (induction φ rule: get_and_list.induct) (simp_all add: safe_neg_def list_all_iff)

lemma sat_get_and: "sat σ V v i φ  list_all (sat σ V v i) (get_and_list φ)"
  by (induction φ rule: get_and_list.induct) (simp_all add: list_all_iff)

fun convert_multiway :: "formula  formula" where
  "convert_multiway (Neg φ) = Neg (convert_multiway φ)"
| "convert_multiway (Or φ ψ) = Or (convert_multiway φ) (convert_multiway ψ)"
| "convert_multiway (And φ ψ) = (if safe_assignment (fv φ) ψ then
      And (convert_multiway φ) ψ
    else if safe_formula ψ then
      Ands (get_and_list (convert_multiway φ) @ get_and_list (convert_multiway ψ))
    else if is_constraint ψ then
      And (convert_multiway φ) ψ
    else Ands (convert_multiway ψ # get_and_list (convert_multiway φ)))"
| "convert_multiway (Exists φ) = Exists (convert_multiway φ)"
| "convert_multiway (Agg y ω b f φ) = Agg y ω b f (convert_multiway φ)"
| "convert_multiway (Prev I φ) = Prev I (convert_multiway φ)"
| "convert_multiway (Next I φ) = Next I (convert_multiway φ)"
| "convert_multiway (Since φ I ψ) = Since (convert_multiway φ) I (convert_multiway ψ)"
| "convert_multiway (Until φ I ψ) = Until (convert_multiway φ) I (convert_multiway ψ)"
| "convert_multiway (MatchP I r) = MatchP I (Regex.map_regex convert_multiway r)"
| "convert_multiway (MatchF I r) = MatchF I (Regex.map_regex convert_multiway r)"
| "convert_multiway φ = φ"

abbreviation "convert_multiway_regex  Regex.map_regex convert_multiway"

lemma fv_safe_get_and:
  "safe_formula φ  fv φ  (x(set (filter safe_formula (get_and_list φ))). fv x)"
proof (induction φ rule: get_and_list.induct)
  case (1 l)
  obtain pos neg where posneg: "(pos, neg) = partition safe_formula l" by simp
  have "get_and_list (Ands l) = l" by simp
  have sub: "(xset neg. fv x)  (xset pos. fv x)" using "1.prems" posneg by simp
  then have "fv (Ands l)  (xset pos. fv x)"
  proof -
    have "fv (Ands l) = (xset pos. fv x)  (xset neg. fv x)" using posneg by auto
    then show ?thesis using sub by simp
  qed
  then show ?case using posneg by auto
qed auto

lemma ex_safe_get_and:
  "safe_formula φ  list_ex safe_formula (get_and_list φ)"
proof (induction φ rule: get_and_list.induct)
  case (1 l)
  have "get_and_list (Ands l) = l" by simp
  obtain pos neg where posneg: "(pos, neg) = partition safe_formula l" by simp
  then have "pos  []" using "1.prems" by simp
  then obtain x where "x  set pos" by fastforce
  then show ?case using posneg using Bex_set_list_ex by fastforce
qed simp_all

lemma case_NegE: "(case φ of Neg φ'  P φ' | _  False)  (φ'. φ = Neg φ'  P φ'  Q)  Q"
  by (cases φ) simp_all

lemma convert_multiway_remove_neg: "safe_formula (remove_neg φ)  convert_multiway (remove_neg φ) = remove_neg (convert_multiway φ)"
  by (cases φ) (auto elim: case_NegE)

lemma fv_convert_multiway: "safe_formula φ  fvi b (convert_multiway φ) = fvi b φ"
proof (induction φ arbitrary: b rule: safe_formula.induct)
  case (9 φ ψ)
  then show ?case by (cases ψ) (auto simp: fv_get_and Un_commute)
next
  case (15 φ I ψ)
  show ?case proof (cases "safe_formula φ")
    case True
    with 15 show ?thesis by simp
  next
    case False
    with "15.prems" obtain φ' where "φ = Neg φ'" by (simp split: formula.splits)
    with False 15 show ?thesis by simp
  qed
next
  case (16 φ I ψ)
  show ?case proof (cases "safe_formula φ")
    case True
    with 16 show ?thesis by simp
  next
    case False
    with "16.prems" obtain φ' where "φ = Neg φ'" by (simp split: formula.splits)
    with False 16 show ?thesis by simp
  qed
next
  case (17 I r)
  then show ?case
    unfolding convert_multiway.simps fvi.simps fv_regex_alt regex.set_map image_image
    by (intro arg_cong[where f=Union, OF image_cong[OF refl]])
      (auto dest!: safe_regex_safe_formula)
next
  case (18 I r)
  then show ?case
    unfolding convert_multiway.simps fvi.simps fv_regex_alt regex.set_map image_image
    by (intro arg_cong[where f=Union, OF image_cong[OF refl]])
      (auto dest!: safe_regex_safe_formula)
qed (auto simp del: convert_multiway.simps(3))

lemma get_and_nonempty:
  assumes "safe_formula φ"
  shows "get_and_list φ  []"
  using assms by (induction φ) auto

lemma future_bounded_get_and:
  "list_all future_bounded (get_and_list φ) = future_bounded φ"
  by (induction φ) simp_all

lemma safe_convert_multiway: "safe_formula φ  safe_formula (convert_multiway φ)"
proof (induction φ rule: safe_formula_induct)
  case (And_safe φ ψ)
  let ?a = "And φ ψ"
  let ?b = "convert_multiway ?a"
  let ?cφ = "convert_multiway φ"
  let ?cψ = "convert_multiway ψ"
  have b_def: "?b = Ands (get_and_list ?cφ @ get_and_list ?cψ)"
    using And_safe by simp
  show ?case proof -
    let ?l = "get_and_list ?cφ @ get_and_list ?cψ"
    obtain pos neg where posneg: "(pos, neg) = partition safe_formula ?l" by simp
    then have "list_all safe_formula pos" by (auto simp: list_all_iff)
    have lsafe_neg: "list_all safe_neg ?l"
      using And_safe ‹safe_formula φ ‹safe_formula ψ
      by (simp add: safe_get_and)
    then have "list_all safe_formula (map remove_neg neg)"
    proof -
      have "x. x  set neg  safe_formula (remove_neg x)"
      proof -
        fix x assume "x  set neg"
        then have "¬ safe_formula x" using posneg by auto
        moreover have "safe_neg x" using lsafe_neg x  set neg
          unfolding safe_neg_def list_all_iff partition_set[OF posneg[symmetric], symmetric]
          by simp
        ultimately show "safe_formula (remove_neg x)" using safe_neg_def by blast
      qed
      then show ?thesis by (auto simp: list_all_iff)
    qed

    have pos_filter: "pos = filter safe_formula (get_and_list ?cφ @ get_and_list ?cψ)"
      using posneg by simp
    have "(xset neg. fv x)  (xset pos. fv x)"
    proof -
      have 1: "fv ?cφ  (x(set (filter safe_formula (get_and_list ?cφ))). fv x)" (is "_  ?fvφ")
        using And_safe ‹safe_formula φ by (blast intro!: fv_safe_get_and)
      have 2: "fv ?cψ  (x(set (filter safe_formula (get_and_list ?cψ))). fv x)" (is "_  ?fvψ")
        using And_safe ‹safe_formula ψ by (blast intro!: fv_safe_get_and)
      have "(xset neg. fv x)  fv ?cφ  fv ?cψ" proof -
        have " (fv ` set neg)   (fv ` (set pos  set neg))"
          by simp
        also have "...  fv (convert_multiway φ)  fv (convert_multiway ψ)"
          unfolding partition_set[OF posneg[symmetric], simplified]
          by (simp add: fv_get_and)
        finally show ?thesis .
      qed
      then have "(xset neg. fv x)  ?fvφ  ?fvψ" using 1 2 by blast
      then show ?thesis unfolding pos_filter by simp
    qed
    have "pos  []"
    proof -
      obtain x where "x  set (get_and_list ?cφ)" "safe_formula x"
        using And_safe ‹safe_formula φ ex_safe_get_and by (auto simp: list_ex_iff)
      then show ?thesis
        unfolding pos_filter by (auto simp: filter_empty_conv)
    qed
    then show ?thesis unfolding b_def
      using  (fv ` set neg)   (fv ` set pos) ‹list_all safe_formula (map remove_neg neg)
        ‹list_all safe_formula pos posneg
      by simp
  qed
next
  case (And_Not φ ψ)
  let ?a = "And φ (Neg ψ)"
  let ?b = "convert_multiway ?a"
  let ?cφ = "convert_multiway φ"
  let ?cψ = "convert_multiway ψ"
  have b_def: "?b = Ands (Neg ?cψ # get_and_list ?cφ)"
    using And_Not by simp
  show ?case proof -
    let ?l = "Neg ?cψ # get_and_list ?cφ"
    note ‹safe_formula ?cφ
    then have "list_all safe_neg (get_and_list ?cφ)" by (simp add: safe_get_and)
    moreover have "safe_neg (Neg ?cψ)"
      using ‹safe_formula ?cψ by (simp add: safe_neg_def)
    then have lsafe_neg: "list_all safe_neg ?l" using calculation by simp
    obtain pos neg where posneg: "(pos, neg) = partition safe_formula ?l" by simp
    then have "list_all safe_formula pos" by (auto simp: list_all_iff)
    then have "list_all safe_formula (map remove_neg neg)"
    proof -
      have "x. x  (set neg)  safe_formula (remove_neg x)"
      proof -
        fix x assume "x  set neg"
        then have "¬ safe_formula x" using posneg by (auto simp del: filter.simps)
        moreover have "safe_neg x" using lsafe_neg x  set neg
          unfolding safe_neg_def list_all_iff partition_set[OF posneg[symmetric], symmetric]
          by simp
        ultimately show "safe_formula (remove_neg x)" using safe_neg_def by blast
      qed
      then show ?thesis using Ball_set_list_all by force
    qed

    have pos_filter: "pos = filter safe_formula ?l"
      using posneg by simp
    have neg_filter: "neg = filter (Not  safe_formula) ?l"
      using posneg by simp
    have "(x(set neg). fv x)  (x(set pos). fv x)"
    proof -
      have fv_neg: "(x(set neg). fv x)  (x(set ?l). fv x)" using posneg by auto
      have "(x(set ?l). fv x)  fv ?cφ  fv ?cψ"
        using ‹safe_formula φ ‹safe_formula ψ
        by (simp add: fv_get_and fv_convert_multiway)
      also have "fv ?cφ  fv ?cψ  fv ?cφ"
        using ‹safe_formula φ ‹safe_formula ψ ‹fv (Neg ψ)  fv φ
        by (simp add: fv_convert_multiway[symmetric])
      finally have "(x(set neg). fv x)  fv ?cφ"
        using fv_neg unfolding neg_filter by blast
      then show ?thesis
        unfolding pos_filter
        using fv_safe_get_and[OF And_Not.IH(1)]
        by auto
    qed
    have "pos  []"
    proof -
      obtain x where "x  set (get_and_list ?cφ)" "safe_formula x"
        using And_Not.IH ‹safe_formula φ ex_safe_get_and by (auto simp: list_ex_iff)
      then show ?thesis
        unfolding pos_filter by (auto simp: filter_empty_conv)
    qed
    then show ?thesis unfolding b_def
      using  (fv ` set neg)   (fv ` set pos) ‹list_all safe_formula (map remove_neg neg)
        ‹list_all safe_formula pos posneg
      by simp
  qed
next
  case (Neg φ)
  have "safe_formula (Neg φ')  safe_formula φ'" if "fv φ' = {}" for φ'
    using that by (cases "Neg φ'" rule: safe_formula.cases) simp_all
  with Neg show ?case by (simp add: fv_convert_multiway)
next
  case (MatchP I r)
  then show ?case
    by (auto 0 3 simp: atms_def fv_convert_multiway intro!: safe_regex_map_regex
      elim!: disjE_Not2 case_NegE
      dest: safe_regex_safe_formula split: if_splits)
next
  case (MatchF I r)
  then show ?case
    by (auto 0 3 simp: atms_def fv_convert_multiway intro!: safe_regex_map_regex
      elim!: disjE_Not2 case_NegE
      dest: safe_regex_safe_formula split: if_splits)
qed (auto simp: fv_convert_multiway)

lemma future_bounded_convert_multiway: "safe_formula φ  future_bounded (convert_multiway φ) = future_bounded φ"
proof (induction φ rule: safe_formula_induct)
  case (And_safe φ ψ)
  let ?a = "And φ ψ"
  let ?b = "convert_multiway ?a"
  let ?cφ = "convert_multiway φ"
  let ?cψ = "convert_multiway ψ"
  have b_def: "?b = Ands (get_and_list ?cφ @ get_and_list ?cψ)"
    using And_safe by simp
  have "future_bounded ?a = (future_bounded ?cφ  future_bounded ?cψ)"
    using And_safe by simp
  moreover have "future_bounded ?cφ = list_all future_bounded (get_and_list ?cφ)"
    using ‹safe_formula φ by (simp add: future_bounded_get_and safe_convert_multiway)
  moreover have "future_bounded ?cψ = list_all future_bounded (get_and_list ?cψ)"
    using ‹safe_formula ψ by (simp add: future_bounded_get_and safe_convert_multiway)
  moreover have "future_bounded ?b = list_all future_bounded (get_and_list ?cφ @ get_and_list ?cψ)"
    unfolding b_def by simp
  ultimately show ?case by simp
next
  case (And_Not φ ψ)
  let ?a = "And φ (Neg ψ)"
  let ?b = "convert_multiway ?a"
  let ?cφ = "convert_multiway φ"
  let ?cψ = "convert_multiway ψ"
  have b_def: "?b = Ands (Neg ?cψ # get_and_list ?cφ)"
    using And_Not by simp
  have "future_bounded ?a = (future_bounded ?cφ  future_bounded ?cψ)"
    using And_Not by simp
  moreover have "future_bounded ?cφ = list_all future_bounded (get_and_list ?cφ)"
    using ‹safe_formula φ by (simp add: future_bounded_get_and safe_convert_multiway)
  moreover have "future_bounded ?b = list_all future_bounded (Neg ?cψ # get_and_list ?cφ)"
    unfolding b_def by (simp add: list.pred_map o_def)
  ultimately show ?case by auto
next
  case (MatchP I r)
  then show ?case
    by (fastforce simp: atms_def regex.pred_set regex.set_map ball_Un
        elim: safe_regex_safe_formula[THEN disjE_Not2])
next
  case (MatchF I r)
  then show ?case
    by (fastforce simp: atms_def regex.pred_set regex.set_map ball_Un
        elim: safe_regex_safe_formula[THEN disjE_Not2])
qed auto

lemma sat_convert_multiway: "safe_formula φ  sat σ V v i (convert_multiway φ)  sat σ V v i φ"
proof (induction φ arbitrary: v i rule: safe_formula_induct)
  case (And_safe φ ψ)
  let ?a = "And φ ψ"
  let ?b = "convert_multiway ?a"
  let ?la = "get_and_list (convert_multiway φ)"
  let ?lb = "get_and_list (convert_multiway ψ)"
  let ?sat = "sat σ V v i"
  have b_def: "?b = Ands (?la @ ?lb)" using And_safe by simp
  have "list_all ?sat ?la  ?sat φ" using And_safe sat_get_and by blast
  moreover have "list_all ?sat ?lb  ?sat ψ" using And_safe sat_get_and by blast
  ultimately show ?case using And_safe by (auto simp: list.pred_set)
next
  case (And_Not φ ψ)
  let ?a = "And φ (Neg ψ)"
  let ?b = "convert_multiway ?a"
  let ?la = "get_and_list (convert_multiway φ)"
  let ?lb = "convert_multiway ψ"
  let ?sat = "sat σ V v i"
  have b_def: "?b = Ands (Neg ?lb # ?la)" using And_Not by simp
  have "list_all ?sat ?la  ?sat φ" using And_Not sat_get_and by blast
  then show ?case using And_Not by (auto simp: list.pred_set)
next
  case (Agg y ω b f φ)
  then show ?case
    by (simp add: nfv_def fv_convert_multiway cong: conj_cong)
next
  case (MatchP I r)
  then have "Regex.match (sat σ V v) (convert_multiway_regex r) = Regex.match (sat σ V v) r"
    unfolding match_map_regex
    by (intro Regex.match_fv_cong)
      (auto 0 4 simp: atms_def elim!: disjE_Not2 dest!: safe_regex_safe_formula)
  then show ?case
    by auto
next
  case (MatchF I r)
  then have "Regex.match (sat σ V v) (convert_multiway_regex r) = Regex.match (sat σ V v) r"
    unfolding match_map_regex
    by (intro Regex.match_fv_cong)
      (auto 0 4 simp: atms_def elim!: disjE_Not2 dest!: safe_regex_safe_formula)
  then show ?case
    by auto
qed (auto cong: nat.case_cong)

end (*context*)

interpretation Formula_slicer: abstract_slicer "relevant_events φ" for φ .

lemma sat_slice_iff:
  assumes "v  S"
  shows "Formula.sat σ V v i φ  Formula.sat (Formula_slicer.slice φ S σ) V v i φ"
  by (rule sat_slice_strong[OF assms]) auto

lemma Neg_splits:
  "P (case φ of formula.Neg ψ  f ψ | φ  g φ) =
   ((ψ. φ = formula.Neg ψ  P (f ψ))  ((¬ Formula.is_Neg φ)  P (g φ)))"
  "P (case φ of formula.Neg ψ  f ψ | _  g φ) =
   (¬ ((ψ. φ = formula.Neg ψ  ¬ P (f ψ))  ((¬ Formula.is_Neg φ)  ¬ P (g φ))))"
  by (cases φ; auto simp: Formula.is_Neg_def)+

(*<*)
end
(*>*)

Theory Optimized_Join

(*<*)
theory Optimized_Join
  imports "Generic_Join.Generic_Join_Correctness"
begin
(*>*)

section ‹Optimized relational join›

subsection ‹Binary join›

definition join_mask :: "nat  nat set  bool list" where
  "join_mask n X = map (λi. i  X) [0..<n]"

fun proj_tuple :: "bool list  'a tuple  'a tuple" where
  "proj_tuple [] [] = []"
| "proj_tuple (True # bs) (a # as) = a # proj_tuple bs as"
| "proj_tuple (False # bs) (a # as) = None # proj_tuple bs as"
| "proj_tuple (b # bs) [] = []"
| "proj_tuple [] (a # as) = []"

lemma proj_tuple_replicate: "(i. i  set bs  ¬i)  length bs = length as 
  proj_tuple bs as = replicate (length bs) None"
  by (induction bs as rule: proj_tuple.induct) fastforce+

lemma proj_tuple_join_mask_empty: "length as = n 
  proj_tuple (join_mask n {}) as = replicate n None"
  using proj_tuple_replicate[of "join_mask n {}"] by (auto simp add: join_mask_def)

lemma proj_tuple_alt: "proj_tuple bs as = map2 (λb a. if b then a else None) bs as"
  by (induction bs as rule: proj_tuple.induct) auto

lemma map2_map: "map2 f (map g [0..<length as]) as = map (λi. f (g i) (as ! i)) [0..<length as]"
  by (rule nth_equalityI) auto

lemma proj_tuple_join_mask_restrict: "length as = n 
  proj_tuple (join_mask n X) as = restrict X as"
  by (auto simp add: restrict_def proj_tuple_alt join_mask_def map2_map)

lemma wf_tuple_proj_idle:
  assumes wf: "wf_tuple n X as"
  shows "proj_tuple (join_mask n X) as = as"
  using proj_tuple_join_mask_restrict[of as n X, unfolded restrict_idle[OF wf]] wf
  by (auto simp add: wf_tuple_def)

lemma wf_tuple_change_base:
  assumes wf: "wf_tuple n X as"
  and mask: "join_mask n X = join_mask n Y"
  shows "wf_tuple n Y as"
  using wf mask by (auto simp add: wf_tuple_def join_mask_def)

definition proj_tuple_in_join :: "bool  bool list  'a tuple  'a table  bool" where
  "proj_tuple_in_join pos bs as t = (if pos then proj_tuple bs as  t else proj_tuple bs as  t)"

abbreviation "join_cond pos t  (λas. if pos then as  t else as  t)"

abbreviation "join_filter_cond pos t  (λas _. join_cond pos t as)"

lemma proj_tuple_in_join_mask_idle:
  assumes wf: "wf_tuple n X as"
  shows "proj_tuple_in_join pos (join_mask n X) as t  join_cond pos t as"
  using wf_tuple_proj_idle[OF wf] by (auto simp add: proj_tuple_in_join_def)

lemma join_sub:
  assumes "L  R" "table n L t1" "table n R t2"
  shows "join t2 pos t1 = {as  t2. proj_tuple_in_join pos (join_mask n L) as t1}"
  using assms proj_tuple_join_mask_restrict[of _ n L] join_restrict[of t2 n R t1 L pos]
    wf_tuple_length restrict_idle
  by (auto simp add: table_def proj_tuple_in_join_def sup.absorb1) fastforce+

lemma join_sub':
  assumes "R  L" "table n L t1" "table n R t2"
  shows "join t2 True t1 = {as  t1. proj_tuple_in_join True (join_mask n R) as t2}"
  using assms proj_tuple_join_mask_restrict[of _ n R] join_restrict[of t2 n R t1 L True]
    wf_tuple_length restrict_idle
  by (auto simp add: table_def proj_tuple_in_join_def sup.absorb1 Un_absorb1) fastforce+

lemma join_eq:
  assumes tab: "table n R t1" "table n R t2"
  shows "join t2 pos t1 = (if pos then t2  t1 else t2 - t1)"
  using join_sub[OF _ tab, of pos] tab(2) proj_tuple_in_join_mask_idle[of n R _ pos t1]
  by (auto simp add: table_def)

lemma join_no_cols:
  assumes tab: "table n {} t1" "table n R t2"
  shows "join t2 pos t1 = (if (pos  replicate n None  t1) then t2 else {})"
  using join_sub[OF _ tab, of pos] tab(2)
  by (auto simp add: table_def proj_tuple_in_join_def wf_tuple_length proj_tuple_join_mask_empty)

lemma join_empty_left: "join {} pos t = {}"
  by (auto simp add: join_def)

lemma join_empty_right: "join t pos {} = (if pos then {} else t)"
  by (auto simp add: join_def)

fun bin_join :: "nat  nat set  'a table  bool  nat set  'a table  'a table" where
  "bin_join n A t pos A' t' =
    (if t = {} then {}
    else if t' = {} then (if pos then {} else t)
    else if A' = {} then (if (pos  replicate n None  t') then t else {})
    else if A' = A then (if pos then t  t' else t - t')
    else if A'  A then {as  t. proj_tuple_in_join pos (join_mask n A') as t'}
    else if A  A'  pos then {as  t'. proj_tuple_in_join pos (join_mask n A) as t}
    else join t pos t')"

lemma bin_join_table:
  assumes tab: "table n A t" "table n A' t'"
  shows "bin_join n A t pos A' t' = join t pos t'"
  using assms join_empty_left[of pos t'] join_empty_right[of t pos]
    join_no_cols[OF _ assms(1), of t' pos] join_eq[of n A t' t pos] join_sub[OF _ assms(2,1)]
    join_sub'[OF _ assms(2,1)]
  by auto+

subsection ‹Multi-way join›

fun mmulti_join' :: "(nat set list  nat set list  'a table list  'a table)" where
  "mmulti_join' A_pos A_neg L = (
    let Q = set (zip A_pos L) in
    let Q_neg = set (zip A_neg (drop (length A_pos) L)) in
    New_max_getIJ_wrapperGenericJoin Q Q_neg)"

lemma mmulti_join'_correct:
  assumes "A_pos  []"
      and "list_all2 (λA X. table n A X  wf_set n A) (A_pos @ A_neg) L"
  shows "z  mmulti_join' A_pos A_neg L  wf_tuple n (Aset A_pos. A) z 
    list_all2 (λA X. restrict A z  X) A_pos (take (length A_pos) L) 
    list_all2 (λA X. restrict A z  X) A_neg (drop (length A_pos) L)"
proof -
  define Q where "Q = set (zip A_pos L)"
  have Q_alt: "Q = set (zip A_pos (take (length A_pos) L))"
    unfolding Q_def by (fastforce simp: in_set_zip)
  define Q_neg where "Q_neg = set (zip A_neg (drop (length A_pos) L))"
  let ?r = "mmulti_join' A_pos A_neg L"
  have "?r = New_max_getIJ_wrapperGenericJoin Q Q_neg"
    unfolding Q_def Q_neg_def by (simp del: New_max.wrapperGenericJoin.simps)
  moreover have "card Q  1"
    unfolding Q_def using assms(1,2)
    by (auto simp: Suc_le_eq card_gt_0_iff zip_eq_Nil_iff)
  moreover have "(A, X)(Q  Q_neg). table n A X  wf_set n A"
    unfolding Q_alt Q_neg_def using assms(2) by (simp add: zip_append1 list_all2_iff)
  ultimately have "z  ?r  wf_tuple n ((A, X)Q. A) z 
      ((A, X)Q. restrict A z  X)  ((A, X)Q_neg. restrict A z  X)"
    using New_max.wrapper_correctness case_prod_beta' by blast
  moreover have "(Aset A_pos. A) = ((A, X)Q. A)" proof -
    from assms(2) have "length A_pos  length L" by (auto dest!: list_all2_lengthD)
    then show ?thesis
      unfolding Q_alt
      by (auto elim: in_set_impl_in_set_zip1[rotated, where ys="take (length A_pos) L"]
          dest: set_zip_leftD)
  qed
  moreover have "z. ((A, X)Q. restrict A z  X) 
    list_all2 (λA X. restrict A z  X) A_pos (take (length A_pos) L)"
    unfolding Q_alt using assms(2) by (auto simp add: list_all2_iff)
  moreover have "z. ((A, X)Q_neg. restrict A z  X) 
    list_all2 (λA X. restrict A z  X) A_neg (drop (length A_pos) L)"
    unfolding Q_neg_def using assms(2) by (auto simp add: list_all2_iff)
  ultimately show ?thesis
    unfolding Q_def Q_neg_def using assms(2) by simp
qed

lemmas restrict_nested = New_max.restrict_nested

lemma list_all2_opt_True:
  assumes "list_all2 (λA X. table n A X  wf_set n A) ((A_zs @ A_x # A_xs @ A_y # A_ys) @ A_neg)
    ((zs @ x # xs @ y # ys) @ L_neg)"
    "length A_xs = length xs" "length A_ys = length ys" "length A_zs = length zs"
  shows "list_all2 (λA X. table n A X  wf_set n A)
    ((A_zs @ (A_x  A_y) # A_xs @ A_ys) @ A_neg) ((zs @ join x True y # xs @ ys) @ L_neg)"
proof -
  have assms_dest: "table n A_x x" "table n A_y y" "wf_set n A_x" "wf_set n A_y"
    using assms
    by (auto simp del: mmulti_join'.simps simp add: list_all2_append1 dest: list_all2_lengthD)
  then have tabs: "table n (A_x  A_y) (join x True y)" "wf_set n (A_x  A_y)"
    using join_table[of n A_x x A_y y True "A_x  A_y", OF assms_dest(1,2)] assms_dest(3,4)
    by (auto simp add: wf_set_def)
  then show "list_all2 (λA X. table n A X  wf_set n A)
    ((A_zs @ (A_x  A_y) # A_xs @ A_ys) @ A_neg) ((zs @ join x True y # xs @ ys) @ L_neg)"
    using assms
    by (auto simp del: mmulti_join'.simps simp add: list_all2_append1 list_all2_append2
        list_all2_Cons1 list_all2_Cons2 dest: list_all2_lengthD) fastforce
qed

lemma mmulti_join'_opt_True:
  assumes "list_all2 (λA X. table n A X  wf_set n A) ((A_zs @ A_x # A_xs @ A_y # A_ys) @ A_neg)
    ((zs @ x # xs @ y # ys) @ L_neg)"
    "length A_xs = length xs" "length A_ys = length ys" "length A_zs = length zs"
  shows "mmulti_join' (A_zs @ A_x # A_xs @ A_y # A_ys) A_neg ((zs @ x # xs @ y # ys) @ L_neg) =
    mmulti_join' (A_zs @ (A_x  A_y) # A_xs @ A_ys) A_neg
    ((zs @ join x True y # xs @ ys) @ L_neg)"
proof -
  have assms_dest: "table n A_x x" "table n A_y y" "wf_set n A_x" "wf_set n A_y"
    using assms
    by (auto simp del: mmulti_join'.simps simp add: list_all2_append1 dest: list_all2_lengthD)
  then have tabs: "table n (A_x  A_y) (join x True y)" "wf_set n (A_x  A_y)"
    using join_table[of n A_x x A_y y True "A_x  A_y", OF assms_dest(1,2)] assms_dest(3,4)
    by (auto simp add: wf_set_def)
  then have list_all2': "list_all2 (λA X. table n A X  wf_set n A)
    ((A_zs @ (A_x  A_y) # A_xs @ A_ys) @ A_neg) ((zs @ join x True y # xs @ ys) @ L_neg)"
    using assms
    by (auto simp del: mmulti_join'.simps simp add: list_all2_append1 list_all2_append2
        list_all2_Cons1 list_all2_Cons2 dest: list_all2_lengthD) fastforce
  have res: "z Z. wf_tuple n Z z  A_x  A_y  Z 
    restrict (A_x  A_y) z  join x True y  restrict A_x z  x  restrict A_y z  y"
    using join_restrict[of x n A_x y A_y True] wf_tuple_restrict_simple[of n _ _ "A_x  A_y"]
      assms_dest(1,2)
    by (auto simp add: table_def restrict_nested Int_absorb2)
  show ?thesis
  proof (rule set_eqI, rule iffI)
    fix z
    assume "z  mmulti_join' (A_zs @ A_x # A_xs @ A_y # A_ys) A_neg
      ((zs @ x # xs @ y # ys) @ L_neg)"
    then have z_in_dest: "wf_tuple n ((set (A_zs @ A_x # A_xs @ A_y # A_ys))) z"
      "list_all2 (λA. (∈) (restrict A z)) A_zs zs"
      "restrict A_x z  x"
      "list_all2 (λA. (∈) (restrict A z)) A_ys ys"
      "restrict A_y z  y"
      "list_all2 (λA. (∈) (restrict A z)) A_xs xs"
      "list_all2 (λA. (∉) (restrict A z)) A_neg L_neg"
      using mmulti_join'_correct[OF _ assms(1), of z]
      by (auto simp del: mmulti_join'.simps simp add: assms list_all2_append1
          dest: list_all2_lengthD)
    then show "z  mmulti_join' (A_zs @ (A_x  A_y) # A_xs @ A_ys) A_neg
      ((zs @ join x True y # xs @ ys) @ L_neg)"
      using mmulti_join'_correct[OF _ list_all2', of z] res[OF z_in_dest(1)]
      by (auto simp add: assms list_all2_appendI le_supI2 Un_assoc simp del: mmulti_join'.simps
          dest: list_all2_lengthD)
  next
    fix z
    assume "z  mmulti_join' (A_zs @ (A_x  A_y) # A_xs @ A_ys) A_neg
      ((zs @ join x True y # xs @ ys) @ L_neg)"
    then have z_in_dest: "wf_tuple n ((set (A_zs @ A_x # A_xs @ A_y # A_ys))) z"
      "list_all2 (λA. (∈) (restrict A z)) A_zs zs"
      "restrict (A_x  A_y) z  join x True y"
      "list_all2 (λA. (∈) (restrict A z)) A_ys ys"
      "list_all2 (λA. (∈) (restrict A z)) A_xs xs"
      "list_all2 (λA. (∉) (restrict A z)) A_neg L_neg"
      using mmulti_join'_correct[OF _ list_all2', of z]
      by (auto simp del: mmulti_join'.simps simp add: assms list_all2_append Un_assoc
          dest: list_all2_lengthD)
    then show "z  mmulti_join' (A_zs @ A_x # A_xs @ A_y # A_ys) A_neg
      ((zs @ x # xs @ y # ys) @ L_neg)"
      using mmulti_join'_correct[OF _ assms(1), of z] res[OF z_in_dest(1)]
      by (auto simp add: assms list_all2_appendI le_supI2 Un_assoc simp del: mmulti_join'.simps
          dest: list_all2_lengthD)
  qed
qed

lemma list_all2_opt_False:
  assumes "list_all2 (λA X. table n A X  wf_set n A)
    ((A_zs @ A_x # A_xs) @ (A_ws @ A_y # A_ys)) ((zs @ x # xs) @ (ws @ y # ys))"
    "length A_ws = length ws" "length A_xs = length xs"
    "length A_ys = length ys" "length A_zs = length zs"
    "A_y  A_x"
  shows "list_all2 (λA X. table n A X  wf_set n A)
    ((A_zs @ A_x # A_xs) @ (A_ws @ A_ys)) ((zs @ join x False y # xs) @ (ws @ ys))"
proof -
  have assms_dest: "table n A_x x" "table n A_y y" "wf_set n A_x" "wf_set n A_y"
    using assms
    by (auto simp del: mmulti_join'.simps simp add: list_all2_append dest: list_all2_lengthD)
  have tabs: "table n A_x (join x False y)"
    using join_table[of n A_x x A_y y False A_x, OF assms_dest(1,2) assms(6)] assms(6) by auto
  then show "list_all2 (λA X. table n A X  wf_set n A)
    ((A_zs @ A_x # A_xs) @ (A_ws @ A_ys)) ((zs @ join x False y # xs) @ (ws @ ys))"
    using assms assms_dest(3)
    by (auto simp del: mmulti_join'.simps simp add: list_all2_append1 list_all2_append2
        list_all2_Cons1 list_all2_Cons2 dest: list_all2_lengthD) fastforce
qed

lemma mmulti_join'_opt_False:
  assumes "list_all2 (λA X. table n A X  wf_set n A)
    ((A_zs @ A_x # A_xs) @ (A_ws @ A_y # A_ys)) ((zs @ x # xs) @ (ws @ y # ys))"
    "length A_ws = length ws" "length A_xs = length xs"
    "length A_ys = length ys" "length A_zs = length zs"
    "A_y  A_x"
  shows "mmulti_join' (A_zs @ A_x # A_xs) (A_ws @ A_y # A_ys) ((zs @ x # xs) @ (ws @ y # ys)) =
    mmulti_join' (A_zs @ A_x # A_xs) (A_ws @ A_ys) ((zs @ join x False y # xs) @ (ws @ ys))"
proof -
  have assms_dest: "table n A_x x" "table n A_y y" "wf_set n A_x" "wf_set n A_y"
    using assms
    by (auto simp del: mmulti_join'.simps simp add: list_all2_append dest: list_all2_lengthD)
  have tabs: "table n A_x (join x False y)"
    using join_table[of n A_x x A_y y False A_x, OF assms_dest(1,2) assms(6)] assms(6) by auto
  then have list_all2': "list_all2 (λA X. table n A X  wf_set n A)
    ((A_zs @ A_x # A_xs) @ (A_ws @ A_ys)) ((zs @ join x False y # xs) @ (ws @ ys))"
    using assms assms_dest(3)
    by (auto simp del: mmulti_join'.simps simp add: list_all2_append1 list_all2_append2
        list_all2_Cons1 list_all2_Cons2 dest: list_all2_lengthD) fastforce
  have res: "z. restrict A_x z  join x False y  restrict A_x z  x  restrict A_y z  y"
    using join_restrict[of x n A_x y A_y False, OF _ _ assms(6)] assms_dest(1,2) assms(6)
    by (auto simp add: table_def restrict_nested Int_absorb2 Un_absorb2)
  show ?thesis
  proof (rule set_eqI, rule iffI)
    fix z
    assume "z  mmulti_join' (A_zs @ A_x # A_xs) (A_ws @ A_y # A_ys)
      ((zs @ x # xs) @ ws @ y # ys)"
    then have z_in_dest: "wf_tuple n ((set (A_zs @ A_x # A_xs))) z"
      "list_all2 (λA. (∈) (restrict A z)) A_zs zs"
      "restrict A_x z  x"
      "list_all2 (λA. (∈) (restrict A z)) A_xs xs"
      "list_all2 (λA. (∉) (restrict A z)) A_ws ws"
      "restrict A_y z  y"
      "list_all2 (λA. (∉) (restrict A z)) A_ys ys"
      using mmulti_join'_correct[OF _ assms(1), of z]
      by (auto simp del: mmulti_join'.simps simp add: assms list_all2_append1
          dest: list_all2_lengthD)
    then show "z  mmulti_join' (A_zs @ A_x # A_xs) (A_ws @ A_ys)
      ((zs @ join x False y # xs) @ ws @ ys)"
      using mmulti_join'_correct[OF _ list_all2', of z] res
      by (auto simp add: assms list_all2_appendI Un_assoc simp del: mmulti_join'.simps
          dest: list_all2_lengthD)
  next
    fix z
    assume "z  mmulti_join' (A_zs @ A_x # A_xs) (A_ws @ A_ys)
      ((zs @ join x False y # xs) @ ws @ ys)"
    then have z_in_dest: "wf_tuple n ((set (A_zs @ A_x # A_xs))) z"
      "list_all2 (λA. (∈) (restrict A z)) A_zs zs"
      "restrict A_x z  join x False y"
      "list_all2 (λA. (∈) (restrict A z)) A_xs xs"
      "list_all2 (λA. (∉) (restrict A z)) A_ws ws"
      "list_all2 (λA. (∉) (restrict A z)) A_ys ys"
      using mmulti_join'_correct[OF _ list_all2', of z]
      by (auto simp del: mmulti_join'.simps simp add: assms list_all2_append1
          dest: list_all2_lengthD)
    then show "z  mmulti_join' (A_zs @ A_x # A_xs) (A_ws @ A_y # A_ys)
      ((zs @ x # xs) @ ws @ y # ys)"
      using mmulti_join'_correct[OF _ assms(1), of z] res
      by (auto simp add: assms list_all2_appendI Un_assoc simp del: mmulti_join'.simps
          dest: list_all2_lengthD)
  qed
qed

fun find_sub_in :: "'a set  'a set list  bool 
  ('a set list × 'a set × 'a set list) option" where
  "find_sub_in X [] b = None"
| "find_sub_in X (x # xs) b = (if (x  X  (b  X  x)) then Some ([], x, xs)
    else (case find_sub_in X xs b of None  None | Some (ys, z, zs)  Some (x # ys, z, zs)))"

lemma find_sub_in_sound: "find_sub_in X xs b = Some (ys, z, zs) 
  xs = ys @ z # zs  (z  X  (b  X  z))"
  by (induction X xs b arbitrary: ys z zs rule: find_sub_in.induct)
     (fastforce split: if_splits option.splits)+

fun find_sub_True :: "'a set list 
  ('a set list × 'a set × 'a set list × 'a set × 'a set list) option" where
  "find_sub_True [] = None"
| "find_sub_True (x # xs) = (case find_sub_in x xs True of None 
    (case find_sub_True xs of None  None
    | Some (ys, w, ws, z, zs)  Some (x # ys, w, ws, z, zs))
  | Some (ys, z, zs)  Some ([], x, ys, z, zs))"

lemma find_sub_True_sound: "find_sub_True xs = Some (ys, w, ws, z, zs) 
  xs = ys @ w # ws @ z # zs  (z  w  w  z)"
  using find_sub_in_sound
  by (induction xs arbitrary: ys w ws z zs rule: find_sub_True.induct)
     (fastforce split: option.splits)+

fun find_sub_False :: "'a set list  'a set list 
  (('a set list × 'a set × 'a set list) × ('a set list × 'a set × 'a set list)) option" where
  "find_sub_False [] ns = None"
| "find_sub_False (x # xs) ns = (case find_sub_in x ns False of None 
    (case find_sub_False xs ns of None  None
    | Some ((rs, w, ws), (ys, z, zs))  Some ((x # rs, w, ws), (ys, z, zs)))
  | Some (ys, z, zs)  Some (([], x, xs), (ys, z, zs)))"

lemma find_sub_False_sound: "find_sub_False xs ns = Some ((rs, w, ws), (ys, z, zs)) 
  xs = rs @ w # ws  ns = ys @ z # zs  (z  w)"
  using find_sub_in_sound
  by (induction xs ns arbitrary: rs w ws ys z zs rule: find_sub_False.induct)
     (fastforce split: option.splits)+

fun proj_list_3 :: "'a list  ('b list × 'b × 'b list)  ('a list × 'a × 'a list)" where
  "proj_list_3 xs (ys, z, zs) = (take (length ys) xs, xs ! (length ys),
    take (length zs) (drop (length ys + 1) xs))"

lemma proj_list_3_same:
  assumes "proj_list_3 xs (ys, z, zs) = (ys', z', zs')"
    "length xs = length ys + 1 + length zs"
  shows "xs = ys' @ z' # zs'"
  using assms by (auto simp add: id_take_nth_drop)

lemma proj_list_3_length:
  assumes "proj_list_3 xs (ys, z, zs) = (ys', z', zs')"
    "length xs = length ys + 1 + length zs"
  shows "length ys = length ys'" "length zs = length zs'"
  using assms by auto

fun proj_list_5 :: "'a list 
  ('b list × 'b × 'b list × 'b × 'b list) 
  ('a list × 'a × 'a list × 'a × 'a list)" where
  "proj_list_5 xs (ys, w, ws, z, zs) = (take (length ys) xs, xs ! (length ys),
    take (length ws) (drop (length ys + 1) xs), xs ! (length ys + 1 + length ws),
    drop (length ys + 1 + length ws + 1) xs)"

lemma proj_list_5_same:
  assumes "proj_list_5 xs (ys, w, ws, z, zs) = (ys', w', ws', z', zs')"
    "length xs = length ys + 1 + length ws + 1 + length zs"
  shows "xs = ys' @ w' # ws' @ z' # zs'"
proof -
  have "xs ! length ys # take (length ws) (drop (Suc (length ys)) xs) = take (Suc (length ws)) (drop (length ys) xs)"
    using assms(2) by (simp add: list_eq_iff_nth_eq nth_Cons split: nat.split)
  moreover have "take (Suc (length ws)) (drop (length ys) xs) @ drop (Suc (length ys + length ws)) xs =
      drop (length ys) xs"
    unfolding Suc_eq_plus1 add.assoc[of _ _ 1] add.commute[of _ "length ws + 1"]
      drop_drop[symmetric, of "length ws + 1"] append_take_drop_id ..
  ultimately show ?thesis
    using assms by (auto simp: Cons_nth_drop_Suc append_Cons[symmetric])
qed

lemma proj_list_5_length:
  assumes "proj_list_5 xs (ys, w, ws, z, zs) = (ys', w', ws', z', zs')"
    "length xs = length ys + 1 + length ws + 1 + length zs"
  shows "length ys = length ys'" "length ws = length ws'"
    "length zs = length zs'"
  using assms by auto

fun dominate_True :: "nat set list  'a table list 
  ((nat set list × nat set × nat set list × nat set × nat set list) ×
  ('a table list × 'a table × 'a table list × 'a table × 'a table list)) option" where
  "dominate_True A_pos L_pos = (case find_sub_True A_pos of None  None
  | Some split  Some (split, proj_list_5 L_pos split))"

lemma find_sub_True_proj_list_5_same:
  assumes "find_sub_True xs = Some (ys, w, ws, z, zs)" "length xs = length xs'"
    "proj_list_5 xs' (ys, w, ws, z, zs) = (ys', w', ws', z', zs')"
  shows "xs' = ys' @ w' # ws' @ z' # zs'"
proof -
  have len: "length xs' = length ys + 1 + length ws + 1 + length zs"
    using find_sub_True_sound[OF assms(1)] by (auto simp add: assms(2)[symmetric])
  show ?thesis
    using proj_list_5_same[OF assms(3) len] .
qed

lemma find_sub_True_proj_list_5_length:
  assumes "find_sub_True xs = Some (ys, w, ws, z, zs)" "length xs = length xs'"
    "proj_list_5 xs' (ys, w, ws, z, zs) = (ys', w', ws', z', zs')"
  shows "length ys = length ys'" "length ws = length ws'"
    "length zs = length zs'"
  using find_sub_True_sound[OF assms(1)] proj_list_5_length[OF assms(3)] assms(2) by auto

lemma dominate_True_sound:
  assumes "dominate_True A_pos L_pos = Some ((A_zs, A_x, A_xs, A_y, A_ys), (zs, x, xs, y, ys))"
    "length A_pos = length L_pos"
  shows "A_pos = A_zs @ A_x # A_xs @ A_y # A_ys" "L_pos = zs @ x # xs @ y # ys"
    "length A_xs = length xs" "length A_ys = length ys" "length A_zs = length zs"
  using assms find_sub_True_sound find_sub_True_proj_list_5_same find_sub_True_proj_list_5_length
  by (auto simp del: proj_list_5.simps split: option.splits) fast+

fun dominate_False :: "nat set list  'a table list  nat set list  'a table list 
  (((nat set list × nat set × nat set list) × nat set list × nat set × nat set list) ×
  (('a table list × 'a table × 'a table list) ×
  'a table list × 'a table × 'a table list)) option" where
  "dominate_False A_pos L_pos A_neg L_neg = (case find_sub_False A_pos A_neg of None  None
  | Some (pos_split, neg_split) 
    Some ((pos_split, neg_split), (proj_list_3 L_pos pos_split, proj_list_3 L_neg neg_split)))"

lemma find_sub_False_proj_list_3_same_left:
  assumes "find_sub_False xs ns = Some ((rs, w, ws), (ys, z, zs))"
    "length xs = length xs'" "proj_list_3 xs' (rs, w, ws) = (rs', w', ws')"
  shows "xs' = rs' @ w' # ws'"
proof -
  have len: "length xs' = length rs + 1 + length ws"
    using find_sub_False_sound[OF assms(1)] by (auto simp add: assms(2)[symmetric])
  show ?thesis
    using proj_list_3_same[OF assms(3) len] .
qed

lemma find_sub_False_proj_list_3_length_left:
  assumes "find_sub_False xs ns = Some ((rs, w, ws), (ys, z, zs))"
    "length xs = length xs'" "proj_list_3 xs' (rs, w, ws) = (rs', w', ws')"
  shows "length rs = length rs'" "length ws = length ws'"
  using find_sub_False_sound[OF assms(1)] proj_list_3_length[OF assms(3)] assms(2) by auto

lemma find_sub_False_proj_list_3_same_right:
  assumes "find_sub_False xs ns = Some ((rs, w, ws), (ys, z, zs))"
    "length ns = length ns'" "proj_list_3 ns' (ys, z, zs) = (ys', z', zs')"
  shows "ns' = ys' @ z' # zs'"
proof -
  have len: "length ns' = length ys + 1 + length zs"
    using find_sub_False_sound[OF assms(1)] by (auto simp add: assms(2)[symmetric])
  show ?thesis
    using proj_list_3_same[OF assms(3) len] .
qed

lemma find_sub_False_proj_list_3_length_right:
  assumes "find_sub_False xs ns = Some ((rs, w, ws), (ys, z, zs))"
    "length ns = length ns'" "proj_list_3 ns' (ys, z, zs) = (ys', z', zs')"
  shows "length ys = length ys'" "length zs = length zs'"
  using find_sub_False_sound[OF assms(1)] proj_list_3_length[OF assms(3)] assms(2) by auto

lemma dominate_False_sound:
  assumes "dominate_False A_pos L_pos A_neg L_neg =
    Some (((A_zs, A_x, A_xs), A_ws, A_y, A_ys), ((zs, x, xs), ws, y, ys))"
    "length A_pos = length L_pos" "length A_neg = length L_neg"
  shows "A_pos = (A_zs @ A_x # A_xs)" "A_neg = A_ws @ A_y # A_ys"
    "L_pos = (zs @ x # xs)" "L_neg = ws @ y # ys"
    "length A_ws = length ws" "length A_xs = length xs"
    "length A_ys = length ys" "length A_zs = length zs"
    "A_y  A_x"
  using assms find_sub_False_proj_list_3_same_left find_sub_False_proj_list_3_same_right
    find_sub_False_proj_list_3_length_left find_sub_False_proj_list_3_length_right
    find_sub_False_sound
  by (auto simp del: proj_list_3.simps split: option.splits) fast+

function mmulti_join :: "(nat  nat set list  nat set list  'a table list  'a table)" where
  "mmulti_join n A_pos A_neg L = (if length A_pos + length A_neg  length L then {} else
    let L_pos = take (length A_pos) L; L_neg = drop (length A_pos) L in
    (case dominate_True A_pos L_pos of None 
      (case dominate_False A_pos L_pos A_neg L_neg of None  mmulti_join' A_pos A_neg L
      | Some (((A_zs, A_x, A_xs), A_ws, A_y, A_ys), ((zs, x, xs), ws, y, ys)) 
        mmulti_join n (A_zs @ A_x # A_xs) (A_ws @ A_ys)
        ((zs @ bin_join n A_x x False A_y y # xs) @ (ws @ ys)))
    | Some ((A_zs, A_x, A_xs, A_y, A_ys), (zs, x, xs, y, ys)) 
      mmulti_join n (A_zs @ (A_x  A_y) # A_xs @ A_ys) A_neg
      ((zs @ bin_join n A_x x True A_y y # xs @ ys) @ L_neg)))"
  by pat_completeness auto
termination
  by (relation "measure (λ(n, A_pos, A_neg, L). length A_pos + length A_neg)")
    (use find_sub_True_sound find_sub_False_sound in fastforce split: option.splits›)+

lemma mmulti_join_link:
  assumes "A_pos  []"
      and "list_all2 (λA X. table n A X  wf_set n A) (A_pos @ A_neg) L"
    shows "mmulti_join n A_pos A_neg L = mmulti_join' A_pos A_neg L"
  using assms
proof (induction A_pos A_neg L rule: mmulti_join.induct)
  case (1 n A_pos A_neg L)
  define L_pos where "L_pos = take (length A_pos) L"
  define L_neg where "L_neg = drop (length A_pos) L"
  have L_def: "L = L_pos @ L_neg"
    using L_pos_def L_neg_def by auto
  have lens_match: "length A_pos = length L_pos" "length A_neg = length L_neg"
    using L_pos_def L_neg_def 1(4)[unfolded L_def] by (auto dest: list_all2_lengthD)
  then have lens_sum: "length A_pos + length A_neg = length L"
    by (auto simp add: L_def)
  show ?case
  proof (cases "dominate_True A_pos L_pos")
    case None
    note dom_True = None
    show ?thesis
    proof (cases "dominate_False A_pos L_pos A_neg L_neg")
      case None
      show ?thesis
        by (subst mmulti_join.simps)
           (simp del: dominate_True.simps dominate_False.simps mmulti_join.simps
            mmulti_join'.simps add: Let_def dom_True L_pos_def[symmetric] None
            L_neg_def[symmetric] lens_sum split: option.splits)
    next
      case (Some a)
      then obtain A_zs A_x A_xs A_ws A_y A_ys zs x xs ws y ys where
        dom_False: "dominate_False A_pos L_pos A_neg L_neg =
        Some (((A_zs, A_x, A_xs), A_ws, A_y, A_ys), ((zs, x, xs), ws, y, ys))"
        by (cases a) auto
      note list_all2 = 1(4)[unfolded L_def dominate_False_sound[OF dom_False lens_match]]
      have lens: "length A_ws = length ws" "length A_xs = length xs"
        "length A_ys = length ys" "length A_zs = length zs"
        using dominate_False_sound[OF dom_False lens_match] by auto
      have sub: "A_y  A_x"
        using dominate_False_sound[OF dom_False lens_match] by auto
      have list_all2': "list_all2 (λA X. table n A X  wf_set n A)
        ((A_zs @ A_x # A_xs) @ (A_ws @ A_ys)) ((zs @ join x False y # xs) @ (ws @ ys))"
        using list_all2_opt_False[OF list_all2 lens sub] .
      have tabs: "table n A_x x" "table n A_y y"
        using list_all2 by (auto simp add: lens list_all2_append)
      have bin_join_conv: "join x False y = bin_join n A_x x False A_y y"
        using bin_join_table[OF tabs, symmetric] .
      have mmulti: "mmulti_join n A_pos A_neg L = mmulti_join n (A_zs @ A_x # A_xs) (A_ws @ A_ys)
        ((zs @ bin_join n A_x x False A_y y # xs) @ (ws @ ys))"
        by (subst mmulti_join.simps)
           (simp del: dominate_True.simps dominate_False.simps mmulti_join.simps
            add: Let_def dom_True L_pos_def[symmetric] L_neg_def[symmetric] dom_False lens_sum)
      show ?thesis
        unfolding mmulti
        unfolding L_def dominate_False_sound[OF dom_False lens_match]
        by (rule 1(1)[OF _ L_pos_def L_neg_def dom_True dom_False,
            OF _ _ _ _ _ _ _ _ _ _ _ _ _ list_all2'[unfolded bin_join_conv],
            unfolded mmulti_join'_opt_False[OF list_all2 lens sub, symmetric,
            unfolded bin_join_conv]])
           (auto simp add: lens_sum)
    qed
  next
    case (Some a)
    then obtain A_zs A_x A_xs A_y A_ys zs x xs y ys where dom_True: "dominate_True A_pos L_pos =
      Some ((A_zs, A_x, A_xs, A_y, A_ys), (zs, x, xs, y, ys))"
      by (cases a) auto
    note list_all2 = 1(4)[unfolded L_def dominate_True_sound[OF dom_True lens_match(1)]]
    have lens: "length A_xs = length xs" "length A_ys = length ys" "length A_zs = length zs"
      using dominate_True_sound[OF dom_True lens_match(1)] by auto
    have list_all2': "list_all2 (λA X. table n A X  wf_set n A)
      ((A_zs @ (A_x  A_y) # A_xs @ A_ys) @ A_neg) ((zs @ join x True y # xs @ ys) @ L_neg)"
      using list_all2_opt_True[OF list_all2 lens] .
    have tabs: "table n A_x x" "table n A_y y"
        using list_all2 by (auto simp add: lens list_all2_append)
    have bin_join_conv: "join x True y = bin_join n A_x x True A_y y"
      using bin_join_table[OF tabs, symmetric] .
    have mmulti: "mmulti_join n A_pos A_neg L = mmulti_join n (A_zs @ (A_x  A_y) # A_xs @ A_ys)
      A_neg ((zs @ bin_join n A_x x True A_y y # xs @ ys) @ L_neg)"
      by (subst mmulti_join.simps)
         (simp del: dominate_True.simps dominate_False.simps mmulti_join.simps
          add: Let_def dom_True L_pos_def[symmetric] L_neg_def lens_sum)
    show ?thesis
      unfolding mmulti
      unfolding L_def dominate_True_sound[OF dom_True lens_match(1)]
      by (rule 1(2)[OF _ L_pos_def L_neg_def dom_True,
          OF _ _ _ _ _ _ _ _ _ _ _ list_all2'[unfolded bin_join_conv],
          unfolded mmulti_join'_opt_True[OF list_all2 lens, symmetric,
          unfolded bin_join_conv]])
         (auto simp add: lens_sum)
  qed
qed

lemma mmulti_join_correct:
  assumes "A_pos  []"
      and "list_all2 (λA X. table n A X  wf_set n A) (A_pos @ A_neg) L"
  shows "z  mmulti_join n A_pos A_neg L  wf_tuple n (Aset A_pos. A) z 
    list_all2 (λA X. restrict A z  X) A_pos (take (length A_pos) L) 
    list_all2 (λA X. restrict A z  X) A_neg (drop (length A_pos) L)"
  unfolding mmulti_join_link[OF assms] using mmulti_join'_correct[OF assms] .

(*<*)
end
(*>*)

Theory Monitor

(*<*)
theory Monitor
  imports
    Formula
    Optimized_Join
    "MFOTL_Monitor.Abstract_Monitor"
    "HOL-Library.While_Combinator"
    "HOL-Library.Mapping"
    "Deriving.Derive"
    "Generic_Join.Generic_Join_Correctness"
begin
(*>*)

section ‹Generic monitoring algorithm›

text ‹The algorithm defined here abstracts over the implementation of the temporal operators.›

subsection ‹Monitorable formulas›

definition "mmonitorable φ  safe_formula φ  Formula.future_bounded φ"
definition "mmonitorable_regex b g r  safe_regex b g r  Regex.pred_regex Formula.future_bounded r"

definition is_simple_eq :: "Formula.trm  Formula.trm  bool" where
  "is_simple_eq t1 t2 = (Formula.is_Const t1  (Formula.is_Const t2  Formula.is_Var t2) 
    Formula.is_Var t1  Formula.is_Const t2)"

fun mmonitorable_exec :: "Formula.formula  bool" where
  "mmonitorable_exec (Formula.Eq t1 t2) = is_simple_eq t1 t2"
| "mmonitorable_exec (Formula.Neg (Formula.Eq (Formula.Var x) (Formula.Var y))) = (x = y)"
| "mmonitorable_exec (Formula.Pred e ts) = list_all (λt. Formula.is_Var t  Formula.is_Const t) ts"
| "mmonitorable_exec (Formula.Let p φ ψ) = ({0..<Formula.nfv φ}  Formula.fv φ  mmonitorable_exec φ  mmonitorable_exec ψ)"
| "mmonitorable_exec (Formula.Neg φ) = (fv φ = {}  mmonitorable_exec φ)"
| "mmonitorable_exec (Formula.Or φ ψ) = (fv φ = fv ψ  mmonitorable_exec φ  mmonitorable_exec ψ)"
| "mmonitorable_exec (Formula.And φ ψ) = (mmonitorable_exec φ 
    (safe_assignment (fv φ) ψ  mmonitorable_exec ψ 
      fv ψ  fv φ  (is_constraint ψ  (case ψ of Formula.Neg ψ'  mmonitorable_exec ψ' | _  False))))"
| "mmonitorable_exec (Formula.Ands l) = (let (pos, neg) = partition mmonitorable_exec l in
    pos  []  list_all mmonitorable_exec (map remove_neg neg) 
    (set (map fv neg))  (set (map fv pos)))"
| "mmonitorable_exec (Formula.Exists φ) = (mmonitorable_exec φ)"
| "mmonitorable_exec (Formula.Agg y ω b f φ) = (mmonitorable_exec φ 
    y + b  Formula.fv φ  {0..<b}  Formula.fv φ  Formula.fv_trm f  Formula.fv φ)"
| "mmonitorable_exec (Formula.Prev I φ) = (mmonitorable_exec φ)"
| "mmonitorable_exec (Formula.Next I φ) = (mmonitorable_exec φ)"
| "mmonitorable_exec (Formula.Since φ I ψ) = (Formula.fv φ  Formula.fv ψ 
    (mmonitorable_exec φ  (case φ of Formula.Neg φ'  mmonitorable_exec φ' | _  False))  mmonitorable_exec ψ)"
| "mmonitorable_exec (Formula.Until φ I ψ) = (Formula.fv φ  Formula.fv ψ  right I   
    (mmonitorable_exec φ  (case φ of Formula.Neg φ'  mmonitorable_exec φ' | _  False))  mmonitorable_exec ψ)"
| "mmonitorable_exec (Formula.MatchP I r) = Regex.safe_regex Formula.fv (λg φ. mmonitorable_exec φ  (g = Lax  (case φ of Formula.Neg φ'  mmonitorable_exec φ' | _  False))) Past Strict r"
| "mmonitorable_exec (Formula.MatchF I r) = (Regex.safe_regex Formula.fv (λg φ. mmonitorable_exec φ  (g = Lax  (case φ of Formula.Neg φ'  mmonitorable_exec φ' | _  False))) Futu Strict r  right I  )"
| "mmonitorable_exec _ = False"

lemma cases_Neg_iff:
  "(case φ of formula.Neg ψ  P ψ | _  False)  (ψ. φ = formula.Neg ψ  P ψ)"
  by (cases φ) auto

lemma safe_formula_mmonitorable_exec: "safe_formula φ  Formula.future_bounded φ  mmonitorable_exec φ"
proof (induct φ rule: safe_formula.induct)
  case (8 φ ψ)
  then show ?case
    unfolding safe_formula.simps future_bounded.simps mmonitorable_exec.simps
    by (auto simp: cases_Neg_iff)
next
  case (9 φ ψ)
  then show ?case
    unfolding safe_formula.simps future_bounded.simps mmonitorable_exec.simps
    by (auto simp: cases_Neg_iff)
next
  case (10 l)
  from "10.prems"(2) have bounded: "Formula.future_bounded φ" if "φ  set l" for φ
    using that by (auto simp: list.pred_set)
  obtain poss negs where posnegs: "(poss, negs) = partition safe_formula l" by simp
  obtain posm negm where posnegm: "(posm, negm) = partition mmonitorable_exec l" by simp
  have "set poss  set posm"
  proof (rule subsetI)
    fix x assume "x  set poss"
    then have "x  set l" "safe_formula x" using posnegs by simp_all
    then have "mmonitorable_exec x" using "10.hyps"(1) bounded by blast
    then show "x  set posm" using x  set poss posnegm posnegs by simp
  qed
  then have "set negm  set negs" using posnegm posnegs by auto
  obtain "poss  []" "list_all safe_formula (map remove_neg negs)"
    "(xset negs. fv x)  (xset poss. fv x)"
    using "10.prems"(1) posnegs by simp
  then have "posm  []" using ‹set poss  set posm by auto
  moreover have "list_all mmonitorable_exec (map remove_neg negm)"
  proof -
    let ?l = "map remove_neg negm"
    have "x. x  set ?l  mmonitorable_exec x"
    proof -
      fix x assume "x  set ?l"
      then obtain y where "y  set negm" "x = remove_neg y" by auto
      then have "y  set negs" using ‹set negm  set negs by blast
      then have "safe_formula x"
        unfolding x = remove_neg y using ‹list_all safe_formula (map remove_neg negs)
        by (simp add: list_all_def)
      show "mmonitorable_exec x"
      proof (cases "z. y = Formula.Neg z")
        case True
        then obtain z where "y = Formula.Neg z" by blast
        then show ?thesis
          using "10.hyps"(2)[OF posnegs refl] x = remove_neg y y  set negs posnegs bounded
            ‹safe_formula x by fastforce
      next
        case False
        then have "remove_neg y = y" by (cases y) simp_all
        then have "y = x" unfolding x = remove_neg y by simp
        show ?thesis
          using "10.hyps"(1) y  set negs posnegs ‹safe_formula x unfolding y = x
          by auto
      qed
    qed
    then show ?thesis by (simp add: list_all_iff)
  qed
  moreover have "(xset negm. fv x)  (xset posm. fv x)"
    using  (fv ` set negs)   (fv ` set poss) ‹set poss  set posm ‹set negm  set negs
    by fastforce
  ultimately show ?case using posnegm by simp
next
  case (15 φ I ψ)
  then show ?case
    unfolding safe_formula.simps future_bounded.simps mmonitorable_exec.simps
    by (auto simp: cases_Neg_iff)
next
  case (16 φ I ψ)
  then show ?case
    unfolding safe_formula.simps future_bounded.simps mmonitorable_exec.simps
    by (auto simp: cases_Neg_iff)
next
  case (17 I r)
  then show ?case
    by (auto elim!: safe_regex_mono[rotated] simp: cases_Neg_iff regex.pred_set)
next
  case (18 I r)
  then show ?case
    by (auto elim!: safe_regex_mono[rotated] simp: cases_Neg_iff regex.pred_set)
qed (auto simp add: is_simple_eq_def list.pred_set)

lemma safe_assignment_future_bounded: "safe_assignment X φ  Formula.future_bounded φ"
  unfolding safe_assignment_def by (auto split: formula.splits)

lemma is_constraint_future_bounded: "is_constraint φ  Formula.future_bounded φ"
  by (induction rule: is_constraint.induct) simp_all

lemma mmonitorable_exec_mmonitorable: "mmonitorable_exec φ  mmonitorable φ"
proof (induct φ rule: mmonitorable_exec.induct)
  case (7 φ ψ)
  then show ?case
    unfolding mmonitorable_def mmonitorable_exec.simps safe_formula.simps
    by (auto simp: cases_Neg_iff intro: safe_assignment_future_bounded is_constraint_future_bounded)
next
  case (8 l)
  obtain poss negs where posnegs: "(poss, negs) = partition safe_formula l" by simp
  obtain posm negm where posnegm: "(posm, negm) = partition mmonitorable_exec l" by simp
  have pos_monitorable: "list_all mmonitorable_exec posm" using posnegm by (simp add: list_all_iff)
  have neg_monitorable: "list_all mmonitorable_exec (map remove_neg negm)"
    using "8.prems" posnegm by (simp add: list_all_iff)
  have "set posm  set poss"
    using "8.hyps"(1) posnegs posnegm unfolding mmonitorable_def by auto
  then have "set negs  set negm"
    using posnegs posnegm by auto

  have "poss  []" using "8.prems" posnegm ‹set posm  set poss by auto
  moreover have "list_all safe_formula (map remove_neg negs)"
    using neg_monitorable "8.hyps"(2)[OF posnegm refl] ‹set negs  set negm
    unfolding mmonitorable_def by (auto simp: list_all_iff)
  moreover have " (fv ` set negm)   (fv ` set posm)"
    using "8.prems" posnegm by simp
  then have " (fv ` set negs)   (fv ` set poss)"
    using ‹set posm  set poss ‹set negs  set negm by fastforce
  ultimately have "safe_formula (Formula.Ands l)" using posnegs by simp
  moreover have "Formula.future_bounded (Formula.Ands l)"
  proof -
    have "list_all Formula.future_bounded posm"
      using pos_monitorable "8.hyps"(1) posnegm unfolding mmonitorable_def
      by (auto elim!: list.pred_mono_strong)
    moreover have fnegm: "list_all Formula.future_bounded (map remove_neg negm)"
      using neg_monitorable "8.hyps"(2) posnegm unfolding mmonitorable_def
      by (auto elim!: list.pred_mono_strong)
    then have "list_all Formula.future_bounded negm"
    proof -
      have "x. x  set negm  Formula.future_bounded x"
      proof -
        fix x assume "x  set negm"
        have "Formula.future_bounded (remove_neg x)" using fnegm x  set negm by (simp add: list_all_iff)
        then show "Formula.future_bounded x" by (cases x) auto
      qed
      then show ?thesis by (simp add: list_all_iff)
    qed
    ultimately have "list_all Formula.future_bounded l" using posnegm by (auto simp: list_all_iff)
    then show ?thesis by (auto simp: list_all_iff)
  qed
  ultimately show ?case unfolding mmonitorable_def ..
next
  case (13 φ I ψ)
  then show ?case
    unfolding mmonitorable_def mmonitorable_exec.simps safe_formula.simps
    by (fastforce simp: cases_Neg_iff)
next
  case (14 φ I ψ)
  then show ?case
    unfolding mmonitorable_def mmonitorable_exec.simps safe_formula.simps
    by (fastforce simp: one_enat_def cases_Neg_iff)
next
  case (15 I r)
  then show ?case
    by (auto elim!: safe_regex_mono[rotated] dest: safe_regex_safe[rotated]
        simp: mmonitorable_regex_def mmonitorable_def cases_Neg_iff regex.pred_set)
next
  case (16 I r)
  then show ?case
    by (auto 0 3 elim!: safe_regex_mono[rotated] dest: safe_regex_safe[rotated]
        simp: mmonitorable_regex_def mmonitorable_def cases_Neg_iff regex.pred_set)
qed (auto simp add: mmonitorable_def mmonitorable_regex_def is_simple_eq_def one_enat_def list.pred_set)

lemma monitorable_formula_code[code]: "mmonitorable φ = mmonitorable_exec φ"
  using mmonitorable_exec_mmonitorable safe_formula_mmonitorable_exec mmonitorable_def
  by blast

subsection ‹Handling regular expressions›

datatype mregex =
  MSkip nat
  | MTestPos nat
  | MTestNeg nat
  | MPlus mregex mregex
  | MTimes mregex mregex
  | MStar mregex

primrec ok where
  "ok _ (MSkip n) = True"
| "ok m (MTestPos n) = (n < m)"
| "ok m (MTestNeg n) = (n < m)"
| "ok m (MPlus r s) = (ok m r  ok m s)"
| "ok m (MTimes r s) = (ok m r  ok m s)"
| "ok m (MStar r) = ok m r"

primrec from_mregex where
  "from_mregex (MSkip n) _ = Regex.Skip n"
| "from_mregex (MTestPos n) φs = Regex.Test (φs ! n)"
| "from_mregex (MTestNeg n) φs = (if safe_formula (Formula.Neg (φs ! n))
    then Regex.Test (Formula.Neg (Formula.Neg (Formula.Neg (φs ! n))))
    else Regex.Test (Formula.Neg (φs ! n)))"
| "from_mregex (MPlus r s) φs = Regex.Plus (from_mregex r φs) (from_mregex s φs)"
| "from_mregex (MTimes r s) φs = Regex.Times (from_mregex r φs) (from_mregex s φs)"
| "from_mregex (MStar r) φs = Regex.Star (from_mregex r φs)"

primrec to_mregex_exec where
  "to_mregex_exec (Regex.Skip n) xs = (MSkip n, xs)"
| "to_mregex_exec (Regex.Test φ) xs = (if safe_formula φ then (MTestPos (length xs), xs @ [φ])
     else case φ of Formula.Neg φ'  (MTestNeg (length xs), xs @ [φ']) | _  (MSkip 0, xs))"
| "to_mregex_exec (Regex.Plus r s) xs =
     (let (mr, ys) = to_mregex_exec r xs; (ms, zs) = to_mregex_exec s ys
     in (MPlus mr ms, zs))"
| "to_mregex_exec (Regex.Times r s) xs =
     (let (mr, ys) = to_mregex_exec r xs; (ms, zs) = to_mregex_exec s ys
     in (MTimes mr ms, zs))"
| "to_mregex_exec (Regex.Star r) xs =
     (let (mr, ys) = to_mregex_exec r xs in (MStar mr, ys))"

primrec shift where
  "shift (MSkip n) k = MSkip n"
| "shift (MTestPos i) k = MTestPos (i + k)"
| "shift (MTestNeg i) k = MTestNeg (i + k)"
| "shift (MPlus r s) k = MPlus (shift r k) (shift s k)"
| "shift (MTimes r s) k = MTimes (shift r k) (shift s k)"
| "shift (MStar r) k = MStar (shift r k)"

primrec to_mregex where
  "to_mregex (Regex.Skip n) = (MSkip n, [])"
| "to_mregex (Regex.Test φ) = (if safe_formula φ then (MTestPos 0, [φ])
     else case φ of Formula.Neg φ'  (MTestNeg 0, [φ']) | _  (MSkip 0, []))"
| "to_mregex (Regex.Plus r s) =
     (let (mr, ys) = to_mregex r; (ms, zs) = to_mregex s
     in (MPlus mr (shift ms (length ys)), ys @ zs))"
| "to_mregex (Regex.Times r s) =
     (let (mr, ys) = to_mregex r; (ms, zs) = to_mregex s
     in (MTimes mr (shift ms (length ys)), ys @ zs))"
| "to_mregex (Regex.Star r) =
     (let (mr, ys) = to_mregex r in (MStar mr, ys))"

lemma shift_0: "shift r 0 = r"
  by (induct r) auto

lemma shift_shift: "shift (shift r k) j = shift r (k + j)"
  by (induct r) auto

lemma to_mregex_to_mregex_exec:
  "case to_mregex r of (mr, φs)  to_mregex_exec r xs = (shift mr (length xs), xs @ φs)"
  by (induct r arbitrary: xs)
    (auto simp: shift_shift ac_simps split: formula.splits prod.splits)

lemma to_mregex_to_mregex_exec_Nil[code]: "to_mregex r = to_mregex_exec r []"
  using to_mregex_to_mregex_exec[where xs="[]" and r = r] by (auto simp: shift_0)

lemma ok_mono: "ok m mr  m  n  ok n mr"
  by (induct mr) auto

lemma from_mregex_cong: "ok m mr  (i < m. xs ! i = ys ! i)  from_mregex mr xs = from_mregex mr ys"
  by (induct mr) auto

lemma not_Neg_cases:
  "(ψ. φ  Formula.Neg ψ)  (case φ of formula.Neg ψ  f ψ | _  x) = x"
  by (cases φ) auto

lemma to_mregex_exec_ok:
  "to_mregex_exec r xs = (mr, ys)  zs. ys = xs @ zs  set zs = atms r  ok (length ys) mr"
proof (induct r arbitrary: xs mr ys)
  case (Skip x)
  then show ?case by (auto split: if_splits prod.splits simp: atms_def elim: ok_mono)
next
  case (Test x)
  show ?case proof (cases "x'. x = Formula.Neg x'")
    case True
    with Test show ?thesis by (auto split: if_splits prod.splits simp: atms_def elim: ok_mono)
  next
    case False
    with Test show ?thesis by (auto split: if_splits prod.splits simp: atms_def not_Neg_cases elim: ok_mono)
  qed
next
  case (Plus r1 r2)
  then show ?case by (fastforce split: if_splits prod.splits formula.splits simp: atms_def elim: ok_mono)
next
  case (Times r1 r2)
  then show ?case by (fastforce split: if_splits prod.splits formula.splits simp: atms_def elim: ok_mono)
next
  case (Star r)
  then show ?case by (auto split: if_splits prod.splits simp: atms_def elim: ok_mono)
qed

lemma ok_shift: "ok (i + m) (Monitor.shift r i)  ok m r"
  by (induct r) auto

lemma to_mregex_ok: "to_mregex r = (mr, ys)  set ys = atms r  ok (length ys) mr"
proof (induct r arbitrary: mr ys)
  case (Skip x)
  then show ?case by (auto simp: atms_def elim: ok_mono split: if_splits prod.splits)
next
  case (Test x)
  show ?case proof (cases "x'. x = Formula.Neg x'")
    case True
    with Test show ?thesis by (auto split: if_splits prod.splits simp: atms_def elim: ok_mono)
  next
    case False
    with Test show ?thesis by (auto split: if_splits prod.splits simp: atms_def not_Neg_cases elim: ok_mono)
  qed
next
  case (Plus r1 r2)
  then show ?case by (fastforce simp: ok_shift atms_def elim: ok_mono split: if_splits prod.splits)
next
  case (Times r1 r2)
  then show ?case by (fastforce simp: ok_shift atms_def elim: ok_mono split: if_splits prod.splits)
next
  case (Star r)
  then show ?case by (auto simp: atms_def elim: ok_mono split: if_splits prod.splits)
qed

lemma from_mregex_shift: "from_mregex (shift r (length xs)) (xs @ ys) = from_mregex r ys"
  by (induct r) (auto simp: nth_append)

lemma from_mregex_to_mregex: "safe_regex m g r  case_prod from_mregex (to_mregex r) = r"
  by (induct r rule: safe_regex.induct)
    (auto dest: to_mregex_ok intro!: from_mregex_cong simp: nth_append from_mregex_shift cases_Neg_iff
      split: prod.splits modality.splits)

lemma from_mregex_eq: "safe_regex m g r  to_mregex r = (mr, φs)  from_mregex mr φs = r"
  using from_mregex_to_mregex[of m g r] by auto

lemma from_mregex_to_mregex_exec: "safe_regex m g r  case_prod from_mregex (to_mregex_exec r xs) = r"
proof (induct r arbitrary: xs rule: safe_regex_induct)
  case (Plus b g r s)
  from Plus(3) Plus(1)[of xs] Plus(2)[of "snd (to_mregex_exec r xs)"] show ?case
    by (auto split: prod.splits simp: nth_append dest: to_mregex_exec_ok
        intro!: from_mregex_cong[where m = "length (snd (to_mregex_exec r xs))"])
next
  case (TimesF g r s)
  from TimesF(3) TimesF(2)[of xs] TimesF(1)[of "snd (to_mregex_exec r xs)"] show ?case
    by (auto split: prod.splits simp: nth_append dest: to_mregex_exec_ok
        intro!: from_mregex_cong[where m = "length (snd (to_mregex_exec r xs))"])
next
  case (TimesP g r s)
  from TimesP(3) TimesP(1)[of xs] TimesP(2)[of "snd (to_mregex_exec r xs)"] show ?case
    by (auto split: prod.splits simp: nth_append dest: to_mregex_exec_ok
        intro!: from_mregex_cong[where m = "length (snd (to_mregex_exec r xs))"])
next
  case (Star b g r)
  from Star(2) Star(1)[of xs] show ?case
    by (auto split: prod.splits)
qed (auto split: prod.splits simp: cases_Neg_iff)


derive linorder mregex

subsubsection ‹LPD›

definition saturate where
  "saturate f = while (λS. f S  S) f"

lemma saturate_code[code]:
  "saturate f S = (let S' = f S in if S' = S then S else saturate f S')"
  unfolding saturate_def Let_def
  by (subst while_unfold) auto

definition "MTimesL r S = MTimes r ` S"
definition "MTimesR R s = (λr. MTimes r s) ` R"

primrec LPD where
  "LPD (MSkip n) = (case n of 0  {} | Suc m  {MSkip m})"
| "LPD (MTestPos φ) = {}"
| "LPD (MTestNeg φ) = {}"
| "LPD (MPlus r s) = (LPD r  LPD s)"
| "LPD (MTimes r s) = MTimesR (LPD r) s  LPD s"
| "LPD (MStar r) = MTimesR (LPD r) (MStar r)"

primrec LPDi where
  "LPDi 0 r = {r}"
| "LPDi (Suc i) r = (s  LPD r. LPDi i s)"

lemma LPDi_Suc_alt: "LPDi (Suc i) r = (s  LPDi i r. LPD s)"
  by (induct i arbitrary: r) fastforce+

definition "LPDs r = (i. LPDi i r)"

lemma LPDs_refl: "r  LPDs r"
  by (auto simp: LPDs_def intro: exI[of _ 0])
lemma LPDs_trans: "r  LPD s  s  LPDs t  r  LPDs t"
  by (force simp: LPDs_def LPDi_Suc_alt simp del: LPDi.simps intro: exI[of _ "Suc _"])

lemma LPDi_Test:
  "LPDi i (MSkip 0)  {MSkip 0}"
  "LPDi i (MTestPos φ)  {MTestPos φ}"
  "LPDi i (MTestNeg φ)  {MTestNeg φ}"
  by (induct i) auto

lemma LPDs_Test:
  "LPDs (MSkip 0)  {MSkip 0}"
  "LPDs (MTestPos φ)  {MTestPos φ}"
  "LPDs (MTestNeg φ)  {MTestNeg φ}"
  unfolding LPDs_def using LPDi_Test by blast+

lemma LPDi_MSkip: "LPDi i (MSkip n)  MSkip ` {i. i  n}"
  by (induct i arbitrary: n) (auto dest: set_mp[OF LPDi_Test(1)] simp: le_Suc_eq split: nat.splits)

lemma LPDs_MSkip: "LPDs (MSkip n)  MSkip ` {i. i  n}"
  unfolding LPDs_def using LPDi_MSkip by auto

lemma LPDi_Plus: "LPDi i (MPlus r s)  {MPlus r s}  LPDi i r  LPDi i s"
  by (induct i arbitrary: r s) auto

lemma LPDs_Plus: "LPDs (MPlus r s)  {MPlus r s}  LPDs r  LPDs s"
  unfolding LPDs_def using LPDi_Plus[of _ r s] by auto

lemma LPDi_Times:
  "LPDi i (MTimes r s)  {MTimes r s}  MTimesR (j  i. LPDi j r) s  (j  i. LPDi j s)"
proof (induct i arbitrary: r s)
  case (Suc i)
  show ?case
    by (fastforce simp: MTimesR_def dest: bspec[of _ _ "Suc _"] dest!: set_mp[OF Suc])
qed simp

lemma LPDs_Times: "LPDs (MTimes r s)  {MTimes r s}  MTimesR (LPDs r) s  LPDs s"
  unfolding LPDs_def using LPDi_Times[of _ r s] by (force simp: MTimesR_def)

lemma LPDi_Star: "j  i  LPDi j (MStar r)  {MStar r}  MTimesR (j  i. LPDi j r) (MStar r)"
proof (induct i arbitrary: j r)
  case (Suc i)
  from Suc(2) show ?case
    by (auto 0 5 simp: MTimesR_def image_iff le_Suc_eq
        dest: bspec[of _ _ "Suc 0"] bspec[of _ _ "Suc _"] set_mp[OF Suc(1)] dest!: set_mp[OF LPDi_Times])
qed simp

lemma LPDs_Star: "LPDs (MStar r)  {MStar r}  MTimesR (LPDs r) (MStar r)"
  unfolding LPDs_def using LPDi_Star[OF order_refl, of _ r] by (force simp: MTimesR_def)

lemma finite_LPDs: "finite (LPDs r)"
proof (induct r)
  case (MSkip n)
  then show ?case by (intro finite_subset[OF LPDs_MSkip]) simp
next
  case (MTestPos φ)
  then show ?case by (intro finite_subset[OF LPDs_Test(2)]) simp
next
  case (MTestNeg φ)
  then show ?case by (intro finite_subset[OF LPDs_Test(3)]) simp
next
  case (MPlus r s)
  then show ?case by (intro finite_subset[OF LPDs_Plus]) simp
next
  case (MTimes r s)
  then show ?case by (intro finite_subset[OF LPDs_Times]) (simp add: MTimesR_def)
next
  case (MStar r)
  then show ?case by (intro finite_subset[OF LPDs_Star]) (simp add: MTimesR_def)
qed

context begin

private abbreviation (input) "addLPD r  λS. insert r S  Set.bind (insert r S) LPD"

private lemma mono_addLPD: "mono (addLPD r)"
  unfolding mono_def Set.bind_def by auto

private lemma LPDs_aux1: "lfp (addLPD r)  LPDs r"
  by (rule lfp_induct[OF mono_addLPD], auto intro: LPDs_refl LPDs_trans simp: Set.bind_def)

private lemma LPDs_aux2: "LPDi i r  lfp (addLPD r)"
proof (induct i)
  case 0
  then show ?case
    by (subst lfp_unfold[OF mono_addLPD]) auto
next
  case (Suc i)
  then show ?case
    by (subst lfp_unfold[OF mono_addLPD]) (auto simp: LPDi_Suc_alt simp del: LPDi.simps)
qed

lemma LPDs_alt: "LPDs r = lfp (addLPD r)"
  using LPDs_aux1 LPDs_aux2 by (force simp: LPDs_def)

lemma LPDs_code[code]:
  "LPDs r = saturate (addLPD r) {}"
  unfolding LPDs_alt saturate_def
  by (rule lfp_while[OF mono_addLPD _ finite_LPDs, of r]) (auto simp: LPDs_refl LPDs_trans Set.bind_def)

end

subsubsection ‹RPD›

primrec RPD where
  "RPD (MSkip n) = (case n of 0  {} | Suc m  {MSkip m})"
| "RPD (MTestPos φ) = {}"
| "RPD (MTestNeg φ) = {}"
| "RPD (MPlus r s) = (RPD r  RPD s)"
| "RPD (MTimes r s) = MTimesL r (RPD s)  RPD r"
| "RPD (MStar r) = MTimesL (MStar r) (RPD r)"

primrec RPDi where
  "RPDi 0 r = {r}"
| "RPDi (Suc i) r = (s  RPD r. RPDi i s)"

lemma RPDi_Suc_alt: "RPDi (Suc i) r = (s  RPDi i r. RPD s)"
  by (induct i arbitrary: r) fastforce+

definition "RPDs r = (i. RPDi i r)"

lemma RPDs_refl: "r  RPDs r"
  by (auto simp: RPDs_def intro: exI[of _ 0])
lemma RPDs_trans: "r  RPD s  s  RPDs t  r  RPDs t"
  by (force simp: RPDs_def RPDi_Suc_alt simp del: RPDi.simps intro: exI[of _ "Suc _"])

lemma RPDi_Test:
  "RPDi i (MSkip 0)  {MSkip 0}"
  "RPDi i (MTestPos φ)  {MTestPos φ}"
  "RPDi i (MTestNeg φ)  {MTestNeg φ}"
  by (induct i) auto

lemma RPDs_Test:
  "RPDs (MSkip 0)  {MSkip 0}"
  "RPDs (MTestPos φ)  {MTestPos φ}"
  "RPDs (MTestNeg φ)  {MTestNeg φ}"
  unfolding RPDs_def using RPDi_Test by blast+

lemma RPDi_MSkip: "RPDi i (MSkip n)  MSkip ` {i. i  n}"
  by (induct i arbitrary: n) (auto dest: set_mp[OF RPDi_Test(1)] simp: le_Suc_eq split: nat.splits)

lemma RPDs_MSkip: "RPDs (MSkip n)  MSkip ` {i. i  n}"
  unfolding RPDs_def using RPDi_MSkip by auto

lemma RPDi_Plus: "RPDi i (MPlus r s)  {MPlus r s}  RPDi i r  RPDi i s"
  by (induct i arbitrary: r s) auto

lemma RPDi_Suc_RPD_Plus:
  "RPDi (Suc i) r  RPDs (MPlus r s)"
  "RPDi (Suc i) s  RPDs (MPlus r s)"
  unfolding RPDs_def by (force intro!: exI[of _ "Suc i"])+

lemma RPDs_Plus: "RPDs (MPlus r s)  {MPlus r s}  RPDs r  RPDs s"
  unfolding RPDs_def using RPDi_Plus[of _ r s] by auto

lemma RPDi_Times:
  "RPDi i (MTimes r s)  {MTimes r s}  MTimesL r (j  i. RPDi j s)  (j  i. RPDi j r)"
proof (induct i arbitrary: r s)
  case (Suc i)
  show ?case
    by (fastforce simp: MTimesL_def dest: bspec[of _ _ "Suc _"] dest!: set_mp[OF Suc])
qed simp

lemma RPDs_Times: "RPDs (MTimes r s)  {MTimes r s}  MTimesL r (RPDs s)  RPDs r"
  unfolding RPDs_def using RPDi_Times[of _ r s] by (force simp: MTimesL_def)

lemma RPDi_Star: "j  i  RPDi j (MStar r)  {MStar r}  MTimesL (MStar r) (j  i. RPDi j r)"
proof (induct i arbitrary: j r)
  case (Suc i)
  from Suc(2) show ?case
    by (auto 0 5 simp: MTimesL_def image_iff le_Suc_eq
        dest: bspec[of _ _ "Suc 0"] bspec[of _ _ "Suc _"] set_mp[OF Suc(1)] dest!: set_mp[OF RPDi_Times])
qed simp

lemma RPDs_Star: "RPDs (MStar r)  {MStar r}  MTimesL (MStar r) (RPDs r)"
  unfolding RPDs_def using RPDi_Star[OF order_refl, of _ r] by (force simp: MTimesL_def)

lemma finite_RPDs: "finite (RPDs r)"
proof (induct r)
  case MSkip
  then show ?case by (intro finite_subset[OF RPDs_MSkip]) simp
next
  case (MTestPos φ)
  then show ?case by (intro finite_subset[OF RPDs_Test(2)]) simp
next
  case (MTestNeg φ)
  then show ?case by (intro finite_subset[OF RPDs_Test(3)]) simp
next
  case (MPlus r s)
  then show ?case by (intro finite_subset[OF RPDs_Plus]) simp
next
  case (MTimes r s)
  then show ?case by (intro finite_subset[OF RPDs_Times]) (simp add: MTimesL_def)
next
  case (MStar r)
  then show ?case by (intro finite_subset[OF RPDs_Star]) (simp add: MTimesL_def)
qed

context begin

private abbreviation (input) "addRPD r  λS. insert r S  Set.bind (insert r S) RPD"

private lemma mono_addRPD: "mono (addRPD r)"
  unfolding mono_def Set.bind_def by auto

private lemma RPDs_aux1: "lfp (addRPD r)  RPDs r"
  by (rule lfp_induct[OF mono_addRPD], auto intro: RPDs_refl RPDs_trans simp: Set.bind_def)

private lemma RPDs_aux2: "RPDi i r  lfp (addRPD r)"
proof (induct i)
  case 0
  then show ?case
    by (subst lfp_unfold[OF mono_addRPD]) auto
next
  case (Suc i)
  then show ?case
    by (subst lfp_unfold[OF mono_addRPD]) (auto simp: RPDi_Suc_alt simp del: RPDi.simps)
qed

lemma RPDs_alt: "RPDs r = lfp (addRPD r)"
  using RPDs_aux1 RPDs_aux2 by (force simp: RPDs_def)

lemma RPDs_code[code]:
  "RPDs r = saturate (addRPD r) {}"
  unfolding RPDs_alt saturate_def
  by (rule lfp_while[OF mono_addRPD _ finite_RPDs, of r]) (auto simp: RPDs_refl RPDs_trans Set.bind_def)

end

subsection ‹The executable monitor›

type_synonym ts = nat

type_synonym 'a mbuf2 = "'a table list × 'a table list"
type_synonym 'a mbufn = "'a table list list"
type_synonym 'a msaux = "(ts × 'a table) list"
type_synonym 'a muaux = "(ts × 'a table × 'a table) list"
type_synonym 'a mrδaux = "(ts × (mregex, 'a table) mapping) list"
type_synonym 'a mlδaux = "(ts × 'a table list × 'a table) list"

datatype mconstraint = MEq | MLess | MLessEq

record args =
  args_ivl :: 
  args_n :: nat
  args_L :: "nat set"
  args_R :: "nat set"
  args_pos :: bool

datatype (dead 'msaux, dead 'muaux) mformula =
  MRel "event_data table"
  | MPred Formula.name "Formula.trm list"
  | MLet Formula.name nat "('msaux, 'muaux) mformula" "('msaux, 'muaux) mformula"
  | MAnd "nat set" "('msaux, 'muaux) mformula" bool "nat set" "('msaux, 'muaux) mformula" "event_data mbuf2"
  | MAndAssign "('msaux, 'muaux) mformula" "nat × Formula.trm"
  | MAndRel "('msaux, 'muaux) mformula" "Formula.trm × bool × mconstraint × Formula.trm"
  | MAnds "nat set list" "nat set list" "('msaux, 'muaux) mformula list" "event_data mbufn"
  | MOr "('msaux, 'muaux) mformula" "('msaux, 'muaux) mformula" "event_data mbuf2"
  | MNeg "('msaux, 'muaux) mformula"
  | MExists "('msaux, 'muaux) mformula"
  | MAgg bool nat Formula.agg_op nat "Formula.trm" "('msaux, 'muaux) mformula"
  | MPrev  "('msaux, 'muaux) mformula" bool "event_data table list" "ts list"
  | MNext  "('msaux, 'muaux) mformula" bool "ts list"
  | MSince args "('msaux, 'muaux) mformula" "('msaux, 'muaux) mformula" "event_data mbuf2" "ts list" "'msaux"
  | MUntil args "('msaux, 'muaux) mformula" "('msaux, 'muaux) mformula" "event_data mbuf2" "ts list" "'muaux"
  | MMatchP  "mregex" "mregex list" "('msaux, 'muaux) mformula list" "event_data mbufn" "ts list" "event_data mrδaux"
  | MMatchF  "mregex" "mregex list" "('msaux, 'muaux) mformula list" "event_data mbufn" "ts list" "event_data mlδaux"

record ('msaux, 'muaux) mstate =
  mstate_i :: nat
  mstate_m :: "('msaux, 'muaux) mformula"
  mstate_n :: nat

fun eq_rel :: "nat  Formula.trm  Formula.trm  event_data table" where
  "eq_rel n (Formula.Const x) (Formula.Const y) = (if x = y then unit_table n else empty_table)"
| "eq_rel n (Formula.Var x) (Formula.Const y) = singleton_table n x y"
| "eq_rel n (Formula.Const x) (Formula.Var y) = singleton_table n y x"
| "eq_rel n _ _ = undefined"

lemma regex_atms_size: "x  regex.atms r  size x < regex.size_regex size r"
  by (induct r) auto

lemma atms_size:
  assumes "x  atms r"
  shows "size x < Regex.size_regex size r"
proof -
  { fix y assume "y  regex.atms r" "case y of formula.Neg z  x = z | _  False"
    then have "size x < Regex.size_regex size r"
      by (cases y rule: formula.exhaust) (auto dest: regex_atms_size)
  }
  with assms show ?thesis
    unfolding atms_def
    by (auto split: formula.splits dest: regex_atms_size)
qed

definition init_args :: "ℐ  nat  nat set  nat set  bool  args" where
  "init_args I n L R pos = args_ivl = I, args_n = n, args_L = L, args_R = R, args_pos = pos"

locale msaux =
  fixes valid_msaux :: "args  ts  'msaux  event_data msaux  bool"
    and init_msaux :: "args  'msaux"
    and add_new_ts_msaux :: "args  ts  'msaux  'msaux"
    and join_msaux :: "args  event_data table  'msaux  'msaux"
    and add_new_table_msaux :: "args  event_data table  'msaux  'msaux"
    and result_msaux :: "args  'msaux  event_data table"
  assumes valid_init_msaux: "L  R 
    valid_msaux (init_args I n L R pos) 0 (init_msaux (init_args I n L R pos)) []"
  assumes valid_add_new_ts_msaux: "valid_msaux args cur aux auxlist  nt  cur 
    valid_msaux args nt (add_new_ts_msaux args nt aux)
    (filter (λ(t, rel). enat (nt - t)  right (args_ivl args)) auxlist)"
  assumes valid_join_msaux: "valid_msaux args cur aux auxlist 
    table (args_n args) (args_L args) rel1 
    valid_msaux args cur (join_msaux args rel1 aux)
    (map (λ(t, rel). (t, join rel (args_pos args) rel1)) auxlist)"
  assumes valid_add_new_table_msaux: "valid_msaux args cur aux auxlist 
    table (args_n args) (args_R args) rel2 
    valid_msaux args cur (add_new_table_msaux args rel2 aux)
    (case auxlist of
      [] => [(cur, rel2)]
    | ((t, y) # ts)  if t = cur then (t, y  rel2) # ts else (cur, rel2) # auxlist)"
    and valid_result_msaux: "valid_msaux args cur aux auxlist  result_msaux args aux =
    foldr (∪) [rel. (t, rel)  auxlist, left (args_ivl args)  cur - t] {}"

fun check_before :: "ℐ  ts  (ts × 'a × 'b)  bool" where
  "check_before I dt (t, a, b)  enat t + right I < enat dt"

fun proj_thd :: "('a × 'b × 'c)  'c" where
  "proj_thd (t, a1, a2) = a2"

definition update_until :: "args  event_data table  event_data table  ts  event_data muaux  event_data muaux" where
  "update_until args rel1 rel2 nt aux =
    (map (λx. case x of (t, a1, a2)  (t, if (args_pos args) then join a1 True rel1 else a1  rel1,
      if mem (nt - t) (args_ivl args) then a2  join rel2 (args_pos args) a1 else a2)) aux) @
    [(nt, rel1, if left (args_ivl args) = 0 then rel2 else empty_table)]"

lemma map_proj_thd_update_until: "map proj_thd (takeWhile (check_before (args_ivl args) nt) auxlist) =
  map proj_thd (takeWhile (check_before (args_ivl args) nt) (update_until args rel1 rel2 nt auxlist))"
proof (induction auxlist)
  case Nil
  then show ?case by (simp add: update_until_def)
next
  case (Cons a auxlist)
  then show ?case
    by (cases "right (args_ivl args)") (auto simp add: update_until_def split: if_splits prod.splits)
qed

fun eval_until :: "ℐ  ts  event_data muaux  event_data table list × event_data muaux" where
  "eval_until I nt [] = ([], [])"
| "eval_until I nt ((t, a1, a2) # aux) = (if t + right I < nt then
    (let (xs, aux) = eval_until I nt aux in (a2 # xs, aux)) else ([], (t, a1, a2) # aux))"

lemma eval_until_length:
  "eval_until I nt auxlist = (res, auxlist')  length auxlist = length res + length auxlist'"
  by (induction I nt auxlist arbitrary: res auxlist' rule: eval_until.induct)
    (auto split: if_splits prod.splits)

lemma eval_until_res: "eval_until I nt auxlist = (res, auxlist') 
  res = map proj_thd (takeWhile (check_before I nt) auxlist)"
  by (induction I nt auxlist arbitrary: res auxlist' rule: eval_until.induct)
    (auto split: prod.splits)

lemma eval_until_auxlist': "eval_until I nt auxlist = (res, auxlist') 
  auxlist' = drop (length res) auxlist"
  by (induction I nt auxlist arbitrary: res auxlist' rule: eval_until.induct)
    (auto split: if_splits prod.splits)

locale muaux =
  fixes valid_muaux :: "args  ts  'muaux  event_data muaux  bool"
    and init_muaux :: "args  'muaux"
    and add_new_muaux :: "args  event_data table  event_data table  ts  'muaux  'muaux"
    and length_muaux :: "args  'muaux  nat"
    and eval_muaux :: "args  ts  'muaux  event_data table list × 'muaux"
  assumes valid_init_muaux: "L  R 
    valid_muaux (init_args I n L R pos) 0 (init_muaux (init_args I n L R pos)) []"
  assumes valid_add_new_muaux: "valid_muaux args cur aux auxlist 
    table (args_n args) (args_L args) rel1 
    table (args_n args) (args_R args) rel2 
    nt  cur 
    valid_muaux args nt (add_new_muaux args rel1 rel2 nt aux)
    (update_until args rel1 rel2 nt auxlist)"
  assumes valid_length_muaux: "valid_muaux args cur aux auxlist  length_muaux args aux = length auxlist"
  assumes valid_eval_muaux: "valid_muaux args cur aux auxlist  nt  cur 
    eval_muaux args nt aux = (res, aux')  eval_until (args_ivl args) nt auxlist = (res', auxlist') 
    res = res'  valid_muaux args cur aux' auxlist'"

locale maux = msaux valid_msaux init_msaux add_new_ts_msaux join_msaux add_new_table_msaux result_msaux +
  muaux valid_muaux init_muaux add_new_muaux length_muaux eval_muaux
  for valid_msaux :: "args  ts  'msaux  event_data msaux  bool"
    and init_msaux :: "args  'msaux"
    and add_new_ts_msaux :: "args  ts  'msaux  'msaux"
    and join_msaux :: "args  event_data table  'msaux  'msaux"
    and add_new_table_msaux :: "args  event_data table  'msaux  'msaux"
    and result_msaux :: "args  'msaux  event_data table"
    and valid_muaux :: "args  ts  'muaux  event_data muaux  bool"
    and init_muaux :: "args  'muaux"
    and add_new_muaux :: "args  event_data table  event_data table  ts  'muaux  'muaux"
    and length_muaux :: "args  'muaux  nat"
    and eval_muaux :: "args  nat  'muaux  event_data table list × 'muaux"

fun split_assignment :: "nat set  Formula.formula  nat × Formula.trm" where
  "split_assignment X (Formula.Eq t1 t2) = (case (t1, t2) of
      (Formula.Var x, Formula.Var y)  if x  X then (y, t1) else (x, t2)
    | (Formula.Var x, _)  (x, t2)
    | (_, Formula.Var y)  (y, t1))"
| "split_assignment _ _ = undefined"

fun split_constraint :: "Formula.formula  Formula.trm × bool × mconstraint × Formula.trm" where
  "split_constraint (Formula.Eq t1 t2) = (t1, True, MEq, t2)"
| "split_constraint (Formula.Less t1 t2) = (t1, True, MLess, t2)"
| "split_constraint (Formula.LessEq t1 t2) = (t1, True, MLessEq, t2)"
| "split_constraint (Formula.Neg (Formula.Eq t1 t2)) = (t1, False, MEq, t2)"
| "split_constraint (Formula.Neg (Formula.Less t1 t2)) = (t1, False, MLess, t2)"
| "split_constraint (Formula.Neg (Formula.LessEq t1 t2)) = (t1, False, MLessEq, t2)"
| "split_constraint _ = undefined"

function (in maux) (sequential) minit0 :: "nat  Formula.formula  ('msaux, 'muaux) mformula" where
  "minit0 n (Formula.Neg φ) = (if fv φ = {} then MNeg (minit0 n φ) else MRel empty_table)"
| "minit0 n (Formula.Eq t1 t2) = MRel (eq_rel n t1 t2)"
| "minit0 n (Formula.Pred e ts) = MPred e ts"
| "minit0 n (Formula.Let p φ ψ) = MLet p (Formula.nfv φ) (minit0 (Formula.nfv φ) φ) (minit0 n ψ)"
| "minit0 n (Formula.Or φ ψ) = MOr (minit0 n φ) (minit0 n ψ) ([], [])"
| "minit0 n (Formula.And φ ψ) = (if safe_assignment (fv φ) ψ then
      MAndAssign (minit0 n φ) (split_assignment (fv φ) ψ)
    else if safe_formula ψ then
      MAnd (fv φ) (minit0 n φ) True (fv ψ) (minit0 n ψ) ([], [])
    else if is_constraint ψ then
      MAndRel (minit0 n φ) (split_constraint ψ)
    else (case ψ of Formula.Neg ψ 
      MAnd (fv φ) (minit0 n φ) False (fv ψ) (minit0 n ψ) ([], [])))"
| "minit0 n (Formula.Ands l) = (let (pos, neg) = partition safe_formula l in
    let mpos = map (minit0 n) pos in
    let mneg = map (minit0 n) (map remove_neg neg) in
    let vpos = map fv pos in
    let vneg = map fv neg in
    MAnds vpos vneg (mpos @ mneg) (replicate (length l) []))"
| "minit0 n (Formula.Exists φ) = MExists (minit0 (Suc n) φ)"
| "minit0 n (Formula.Agg y ω b f φ) = MAgg (fv φ  {0..<b}) y ω b f (minit0 (b + n) φ)"
| "minit0 n (Formula.Prev I φ) = MPrev I (minit0 n φ) True [] []"
| "minit0 n (Formula.Next I φ) = MNext I (minit0 n φ) True []"
| "minit0 n (Formula.Since φ I ψ) = (if safe_formula φ
    then MSince (init_args I n (Formula.fv φ) (Formula.fv ψ) True) (minit0 n φ) (minit0 n ψ) ([], []) [] (init_msaux (init_args I n (Formula.fv φ) (Formula.fv ψ) True))
    else (case φ of
      Formula.Neg φ  MSince (init_args I n (Formula.fv φ) (Formula.fv ψ) False) (minit0 n φ) (minit0 n ψ) ([], []) [] (init_msaux (init_args I n (Formula.fv φ) (Formula.fv ψ) False))
    | _  undefined))"
| "minit0 n (Formula.Until φ I ψ) = (if safe_formula φ
    then MUntil (init_args I n (Formula.fv φ) (Formula.fv ψ) True) (minit0 n φ) (minit0 n ψ) ([], []) [] (init_muaux (init_args I n (Formula.fv φ) (Formula.fv ψ) True))
    else (case φ of
      Formula.Neg φ  MUntil (init_args I n (Formula.fv φ) (Formula.fv ψ) False) (minit0 n φ) (minit0 n ψ) ([], []) [] (init_muaux (init_args I n (Formula.fv φ) (Formula.fv ψ) False))
    | _  undefined))"
| "minit0 n (Formula.MatchP I r) =
    (let (mr, φs) = to_mregex r
    in MMatchP I mr (sorted_list_of_set (RPDs mr)) (map (minit0 n) φs) (replicate (length φs) []) [] [])"
| "minit0 n (Formula.MatchF I r) =
    (let (mr, φs) = to_mregex r
    in MMatchF I mr (sorted_list_of_set (LPDs mr)) (map (minit0 n) φs) (replicate (length φs) []) [] [])"
| "minit0 n _ = undefined"
  by pat_completeness auto
termination (in maux)
  by (relation "measure (λ(_, φ). size φ)")
    (auto simp: less_Suc_eq_le size_list_estimation' size_remove_neg
      dest!: to_mregex_ok[OF sym] atms_size)

definition (in maux) minit :: "Formula.formula  ('msaux, 'muaux) mstate" where
  "minit φ = (let n = Formula.nfv φ in mstate_i = 0, mstate_m = minit0 n φ, mstate_n = n)"

definition (in maux) minit_safe where
  "minit_safe φ = (if mmonitorable_exec φ then minit φ else undefined)"

fun mprev_next :: "ℐ  event_data table list  ts list  event_data table list × event_data table list × ts list" where
  "mprev_next I [] ts = ([], [], ts)"
| "mprev_next I xs [] = ([], xs, [])"
| "mprev_next I xs [t] = ([], xs, [t])"
| "mprev_next I (x # xs) (t # t' # ts) = (let (ys, zs) = mprev_next I xs (t' # ts)
    in ((if mem (t' - t) I then x else empty_table) # ys, zs))"

fun mbuf2_add :: "event_data table list  event_data table list  event_data mbuf2  event_data mbuf2" where
  "mbuf2_add xs' ys' (xs, ys) = (xs @ xs', ys @ ys')"

fun mbuf2_take :: "(event_data table  event_data table  'b)  event_data mbuf2  'b list × event_data mbuf2" where
  "mbuf2_take f (x # xs, y # ys) = (let (zs, buf) = mbuf2_take f (xs, ys) in (f x y # zs, buf))"
| "mbuf2_take f (xs, ys) = ([], (xs, ys))"

fun mbuf2t_take :: "(event_data table  event_data table  ts  'b  'b)  'b 
    event_data mbuf2  ts list  'b × event_data mbuf2 × ts list" where
  "mbuf2t_take f z (x # xs, y # ys) (t # ts) = mbuf2t_take f (f x y t z) (xs, ys) ts"
| "mbuf2t_take f z (xs, ys) ts = (z, (xs, ys), ts)"

lemma size_list_length_diff1: "xs  []  []  set xs 
  size_list (λxs. length xs - Suc 0) xs < size_list length xs"
proof (induct xs)
  case (Cons x xs)
  then show ?case
    by (cases xs) auto
qed simp

fun mbufn_add :: "event_data table list list  event_data mbufn  event_data mbufn" where
  "mbufn_add xs' xs = List.map2 (@) xs xs'"

function mbufn_take :: "(event_data table list  'b  'b)  'b  event_data mbufn  'b × event_data mbufn" where
  "mbufn_take f z buf = (if buf = []  []  set buf then (z, buf)
    else mbufn_take f (f (map hd buf) z) (map tl buf))"
  by pat_completeness auto
termination by (relation "measure (λ(_, _, buf). size_list length buf)")
    (auto simp: comp_def Suc_le_eq size_list_length_diff1)

fun mbufnt_take :: "(event_data table list  ts  'b  'b) 
    'b  event_data mbufn  ts list  'b × event_data mbufn × ts list" where
  "mbufnt_take f z buf ts =
    (if []  set buf  ts = [] then (z, buf, ts)
    else mbufnt_take f (f (map hd buf) (hd ts) z) (map tl buf) (tl ts))"

fun match :: "Formula.trm list  event_data list  (nat  event_data) option" where
  "match [] [] = Some Map.empty"
| "match (Formula.Const x # ts) (y # ys) = (if x = y then match ts ys else None)"
| "match (Formula.Var x # ts) (y # ys) = (case match ts ys of
      None  None
    | Some f  (case f x of
        None  Some (f(x  y))
      | Some z  if y = z then Some f else None))"
| "match _ _ = None"

fun meval_trm :: "Formula.trm  event_data tuple  event_data" where
  "meval_trm (Formula.Var x) v = the (v ! x)"
| "meval_trm (Formula.Const x) v = x"
| "meval_trm (Formula.Plus x y) v = meval_trm x v + meval_trm y v"
| "meval_trm (Formula.Minus x y) v = meval_trm x v - meval_trm y v"
| "meval_trm (Formula.UMinus x) v = - meval_trm x v"
| "meval_trm (Formula.Mult x y) v = meval_trm x v * meval_trm y v"
| "meval_trm (Formula.Div x y) v = meval_trm x v div meval_trm y v"
| "meval_trm (Formula.Mod x y) v = meval_trm x v mod meval_trm y v"
| "meval_trm (Formula.F2i x) v = EInt (integer_of_event_data (meval_trm x v))"
| "meval_trm (Formula.I2f x) v = EFloat (double_of_event_data (meval_trm x v))"

definition eval_agg :: "nat  bool  nat  Formula.agg_op  nat  Formula.trm 
  event_data table  event_data table" where
  "eval_agg n g0 y ω b f rel = (if g0  rel = empty_table
    then singleton_table n y (eval_agg_op ω {})
    else (λk.
      let group = Set.filter (λx. drop b x = k) rel;
        M = (λy. (y, ecard (Set.filter (λx. meval_trm f x = y) group))) ` meval_trm f ` group
      in k[y:=Some (eval_agg_op ω M)]) ` (drop b) ` rel)"

definition (in maux) update_since :: "args  event_data table  event_data table  ts 
  'msaux  event_data table × 'msaux" where
  "update_since args rel1 rel2 nt aux =
    (let aux0 = join_msaux args rel1 (add_new_ts_msaux args nt aux);
         aux' = add_new_table_msaux args rel2 aux0
    in (result_msaux args aux', aux'))"

definition "lookup = Mapping.lookup_default empty_table"

fun ε_lax where
  "ε_lax guard φs (MSkip n) = (if n = 0 then guard else empty_table)"
| "ε_lax guard φs (MTestPos i) = join guard True (φs ! i)"
| "ε_lax guard φs (MTestNeg i) = join guard False (φs ! i)"
| "ε_lax guard φs (MPlus r s) = ε_lax guard φs r  ε_lax guard φs s"
| "ε_lax guard φs (MTimes r s) = join (ε_lax guard φs r) True (ε_lax guard φs s)"
| "ε_lax guard φs (MStar r) = guard"

fun rε_strict where
  "rε_strict n φs (MSkip m) = (if m = 0 then unit_table n else empty_table)"
| "rε_strict n φs (MTestPos i) = φs ! i"
| "rε_strict n φs (MTestNeg i) = (if φs ! i = empty_table then unit_table n else empty_table)"
| "rε_strict n φs (MPlus r s) = rε_strict n φs r  rε_strict n φs s"
| "rε_strict n φs (MTimes r s) = ε_lax (rε_strict n φs r) φs s"
| "rε_strict n φs (MStar r) = unit_table n"

fun lε_strict where
  "lε_strict n φs (MSkip m) = (if m = 0 then unit_table n else empty_table)"
| "lε_strict n φs (MTestPos i) = φs ! i"
| "lε_strict n φs (MTestNeg i) = (if φs ! i = empty_table then unit_table n else empty_table)"
| "lε_strict n φs (MPlus r s) = lε_strict n φs r  lε_strict n φs s"
| "lε_strict n φs (MTimes r s) = ε_lax (lε_strict n φs s) φs r"
| "lε_strict n φs (MStar r) = unit_table n"

fun  :: "(mregex  mregex)  (mregex, 'a table) mapping  'a table list  mregex  'a table"  where
  " κ X φs (MSkip n) = (case n of 0  empty_table | Suc m  lookup X (κ (MSkip m)))"
| " κ X φs (MTestPos i) = empty_table"
| " κ X φs (MTestNeg i) = empty_table"
| " κ X φs (MPlus r s) =  κ X φs r   κ X φs s"
| " κ X φs (MTimes r s) =  (λt. κ (MTimes r t)) X φs s  ε_lax ( κ X φs r) φs s"
| " κ X φs (MStar r) =  (λt. κ (MTimes (MStar r) t)) X φs r"

fun  :: "(mregex  mregex)  (mregex, 'a table) mapping  'a table list  mregex  'a table" where
  " κ X φs (MSkip n) = (case n of 0  empty_table | Suc m  lookup X (κ (MSkip m)))"
| " κ X φs (MTestPos i) = empty_table"
| " κ X φs (MTestNeg i) = empty_table"
| " κ X φs (MPlus r s) =  κ X φs r   κ X φs s"
| " κ X φs (MTimes r s) =  (λt. κ (MTimes t s)) X φs r  ε_lax ( κ X φs s) φs r"
| " κ X φs (MStar r) =  (λt. κ (MTimes t (MStar r))) X φs r"

lift_definition mrtabulate :: "mregex list  (mregex  'b table)  (mregex, 'b table) mapping"
  is "λks f. (map_of (List.map_filter (λk. let fk = f k in if fk = empty_table then None else Some (k, fk)) ks))" .

lemma lookup_tabulate:
  "distinct xs  lookup (mrtabulate xs f) x = (if x  set xs then f x else empty_table)"
  unfolding lookup_default_def lookup_def
  by transfer (auto simp: Let_def map_filter_def map_of_eq_None_iff o_def image_image dest!: map_of_SomeD
      split: if_splits option.splits)

definition update_matchP :: "nat  mregex  mregex list  event_data table list  ts 
  event_data mrδaux  event_data table × event_data mrδaux" where
  "update_matchP n I mr mrs rels nt aux =
    (let aux = (case [(t, mrtabulate mrs (λmr.
        rδ id rel rels mr  (if t = nt then rε_strict n rels mr else {}))).
      (t, rel)  aux, enat (nt - t)  right I]
      of []  [(nt, mrtabulate mrs (rε_strict n rels))]
      | x # aux'  (if fst x = nt then x # aux'
                     else (nt, mrtabulate mrs (rε_strict n rels)) # x # aux'))
    in (foldr (∪) [lookup rel mr. (t, rel)  aux, left I  nt - t] {}, aux))"

definition update_matchF_base where
  "update_matchF_base n I mr mrs rels nt =
     (let X = mrtabulate mrs (lε_strict n rels)
     in ([(nt, rels, if left I = 0 then lookup X mr else empty_table)], X))"

definition update_matchF_step where
  "update_matchF_step I mr mrs nt = (λ(t, rels', rel) (aux', X).
     (let Y = mrtabulate mrs (lδ id X rels')
     in ((t, rels', if mem (nt - t) I then rel  lookup Y mr else rel) # aux', Y)))"

definition update_matchF :: "nat  mregex  mregex list  event_data table list  ts  event_data mlδaux  event_data mlδaux" where
  "update_matchF n I mr mrs rels nt aux =
     fst (foldr (update_matchF_step I mr mrs nt) aux (update_matchF_base n I mr mrs rels nt))"

fun eval_matchF :: "ℐ  mregex  ts  event_data mlδaux  event_data table list × event_data mlδaux" where
  "eval_matchF I mr nt [] = ([], [])"
| "eval_matchF I mr nt ((t, rels, rel) # aux) = (if t + right I < nt then
    (let (xs, aux) = eval_matchF I mr nt aux in (rel # xs, aux)) else ([], (t, rels, rel) # aux))"

primrec map_split where
  "map_split f [] = ([], [])"
| "map_split f (x # xs) =
    (let (y, z) = f x; (ys, zs) = map_split f xs
    in (y # ys, z # zs))"

fun eval_assignment :: "nat × Formula.trm  event_data tuple  event_data tuple" where
  "eval_assignment (x, t) y = (y[x:=Some (meval_trm t y)])"

fun eval_constraint0 :: "mconstraint  event_data  event_data  bool" where
  "eval_constraint0 MEq x y = (x = y)"
| "eval_constraint0 MLess x y = (x < y)"
| "eval_constraint0 MLessEq x y = (x  y)"

fun eval_constraint :: "Formula.trm × bool × mconstraint × Formula.trm  event_data tuple  bool" where
  "eval_constraint (t1, p, c, t2) x = (eval_constraint0 c (meval_trm t1 x) (meval_trm t2 x) = p)"

primrec (in maux) meval :: "nat  ts  Formula.database  ('msaux, 'muaux) mformula 
    event_data table list × ('msaux, 'muaux) mformula" where
  "meval n t db (MRel rel) = ([rel], MRel rel)"
| "meval n t db (MPred e ts) = (map (λX. (λf. Table.tabulate f 0 n) ` Option.these
    (match ts ` X)) (case Mapping.lookup db e of None  [{}] | Some xs  xs), MPred e ts)"
| "meval n t db (MLet p m φ ψ) =
    (let (xs, φ) = meval m t db φ; (ys, ψ) = meval n t (Mapping.update p (map (image (map the)) xs) db) ψ
    in (ys, MLet p m φ ψ))"
| "meval n t db (MAnd A_φ φ pos A_ψ ψ buf) =
    (let (xs, φ) = meval n t db φ; (ys, ψ) = meval n t db ψ;
      (zs, buf) = mbuf2_take (λr1 r2. bin_join n A_φ r1 pos A_ψ r2) (mbuf2_add xs ys buf)
    in (zs, MAnd A_φ φ pos A_ψ ψ buf))"
| "meval n t db (MAndAssign φ conf) =
    (let (xs, φ) = meval n t db φ in (map (λr. eval_assignment conf ` r) xs, MAndAssign φ conf))"
| "meval n t db (MAndRel φ conf) =
    (let (xs, φ) = meval n t db φ in (map (Set.filter (eval_constraint conf)) xs, MAndRel φ conf))"
| "meval n t db (MAnds A_pos A_neg L buf) =
    (let R = map (meval n t db) L in
    let buf = mbufn_add (map fst R) buf in
    let (zs, buf) = mbufn_take (λxs zs. zs @ [mmulti_join n A_pos A_neg xs]) [] buf in
    (zs, MAnds A_pos A_neg (map snd R) buf))"
| "meval n t db (MOr φ ψ buf) =
    (let (xs, φ) = meval n t db φ; (ys, ψ) = meval n t db ψ;
      (zs, buf) = mbuf2_take (λr1 r2. r1  r2) (mbuf2_add xs ys buf)
    in (zs, MOr φ ψ buf))"
| "meval n t db (MNeg φ) =
    (let (xs, φ) = meval n t db φ in (map (λr. (if r = empty_table then unit_table n else empty_table)) xs, MNeg φ))"
| "meval n t db (MExists φ) =
    (let (xs, φ) = meval (Suc n) t db φ in (map (λr. tl ` r) xs, MExists φ))"
| "meval n t db (MAgg g0 y ω b f φ) =
    (let (xs, φ) = meval (b + n) t db φ in (map (eval_agg n g0 y ω b f) xs, MAgg g0 y ω b f φ))"
| "meval n t db (MPrev I φ first buf nts) =
    (let (xs, φ) = meval n t db φ;
      (zs, buf, nts) = mprev_next I (buf @ xs) (nts @ [t])
    in (if first then empty_table # zs else zs, MPrev I φ False buf nts))"
| "meval n t db (MNext I φ first nts) =
    (let (xs, φ) = meval n t db φ;
      (xs, first) = (case (xs, first) of (_ # xs, True)  (xs, False) | a  a);
      (zs, _, nts) = mprev_next I xs (nts @ [t])
    in (zs, MNext I φ first nts))"
| "meval n t db (MSince args φ ψ buf nts aux) =
    (let (xs, φ) = meval n t db φ; (ys, ψ) = meval n t db ψ;
      ((zs, aux), buf, nts) = mbuf2t_take (λr1 r2 t (zs, aux).
        let (z, aux) = update_since args r1 r2 t aux
        in (zs @ [z], aux)) ([], aux) (mbuf2_add xs ys buf) (nts @ [t])
    in (zs, MSince args φ ψ buf nts aux))"
| "meval n t db (MUntil args φ ψ buf nts aux) =
    (let (xs, φ) = meval n t db φ; (ys, ψ) = meval n t db ψ;
      (aux, buf, nts) = mbuf2t_take (add_new_muaux args) aux (mbuf2_add xs ys buf) (nts @ [t]);
      (zs, aux) = eval_muaux args (case nts of []  t | nt # _  nt) aux
    in (zs, MUntil args φ ψ buf nts aux))"
| "meval n t db (MMatchP I mr mrs φs buf nts aux) =
    (let (xss, φs) = map_split id (map (meval n t db) φs);
      ((zs, aux), buf, nts) = mbufnt_take (λrels t (zs, aux).
        let (z, aux) = update_matchP n I mr mrs rels t aux
        in (zs @ [z], aux)) ([], aux) (mbufn_add xss buf) (nts @ [t])
    in (zs, MMatchP I mr mrs φs buf nts aux))"
| "meval n t db (MMatchF I mr mrs φs buf nts aux) =
    (let (xss, φs) = map_split id (map (meval n t db) φs);
      (aux, buf, nts) = mbufnt_take (update_matchF n I mr mrs) aux (mbufn_add xss buf) (nts @ [t]);
      (zs, aux) = eval_matchF I mr (case nts of []  t | nt # _  nt) aux
    in (zs, MMatchF I mr mrs φs buf nts aux))"

definition (in maux) mstep :: "Formula.database × ts  ('msaux, 'muaux) mstate  (nat × event_data table) list × ('msaux, 'muaux) mstate" where
  "mstep tdb st =
     (let (xs, m) = meval (mstate_n st) (snd tdb) (fst tdb) (mstate_m st)
     in (List.enumerate (mstate_i st) xs,
      mstate_i = mstate_i st + length xs, mstate_m = m, mstate_n = mstate_n st))"

subsection ‹Verdict delay›

context fixes σ :: Formula.trace begin

fun progress :: "(Formula.name  nat)  Formula.formula  nat  nat" where
  "progress P (Formula.Pred e ts) j = (case P e of None  j | Some k  k)"
| "progress P (Formula.Let p φ ψ) j = progress (P(p  progress P φ j)) ψ j"
| "progress P (Formula.Eq t1 t2) j = j"
| "progress P (Formula.Less t1 t2) j = j"
| "progress P (Formula.LessEq t1 t2) j = j"
| "progress P (Formula.Neg φ) j = progress P φ j"
| "progress P (Formula.Or φ ψ) j = min (progress P φ j) (progress P ψ j)"
| "progress P (Formula.And φ ψ) j = min (progress P φ j) (progress P ψ j)"
| "progress P (Formula.Ands l) j = (if l = [] then j else Min (set (map (λφ. progress P φ j) l)))"
| "progress P (Formula.Exists φ) j = progress P φ j"
| "progress P (Formula.Agg y ω b f φ) j = progress P φ j"
| "progress P (Formula.Prev I φ) j = (if j = 0 then 0 else min (Suc (progress P φ j)) j)"
| "progress P (Formula.Next I φ) j = progress P φ j - 1"
| "progress P (Formula.Since φ I ψ) j = min (progress P φ j) (progress P ψ j)"
| "progress P (Formula.Until φ I ψ) j =
    Inf {i. k. k < j  k  min (progress P φ j) (progress P ψ j)  τ σ i + right I  τ σ k}"
| "progress P (Formula.MatchP I r) j = min_regex_default (progress P) r j"
| "progress P (Formula.MatchF I r) j =
    Inf {i. k. k < j  k  min_regex_default (progress P) r j  τ σ i + right I  τ σ k}"

definition "progress_regex P = min_regex_default (progress P)"

declare progress.simps[simp del]
lemmas progress_simps[simp] = progress.simps[folded progress_regex_def[THEN fun_cong, THEN fun_cong]]

end

definition "pred_mapping Q = pred_fun (λ_. True) (pred_option Q)"
definition "rel_mapping Q = rel_fun (=) (rel_option Q)"

lemma pred_mapping_alt: "pred_mapping Q P = (p  dom P. Q (the (P p)))"
  unfolding pred_mapping_def pred_fun_def option.pred_set dom_def
  by (force split: option.splits)

lemma rel_mapping_alt: "rel_mapping Q P P' = (dom P = dom P'  (p  dom P. Q (the (P p)) (the (P' p))))"
  unfolding rel_mapping_def rel_fun_def rel_option_iff dom_def
  by (force split: option.splits)

lemma rel_mapping_map_upd[simp]: "Q x y  rel_mapping Q P P'  rel_mapping Q (P(p  x)) (P'(p  y))"
  by (auto simp: rel_mapping_alt)

lemma pred_mapping_map_upd[simp]: "Q x  pred_mapping Q P  pred_mapping Q (P(p  x))"
  by (auto simp: pred_mapping_alt)

lemma pred_mapping_empty[simp]: "pred_mapping Q Map.empty"
  by (auto simp: pred_mapping_alt)

lemma pred_mapping_mono: "pred_mapping Q P  Q  R  pred_mapping R P"
  by (auto simp: pred_mapping_alt)

lemma pred_mapping_mono_strong: "pred_mapping Q P 
  (p. p  dom P  Q (the (P p))  R (the (P p)))  pred_mapping R P"
  by (auto simp: pred_mapping_alt)

lemma progress_mono_gen: "j  j'  rel_mapping (≤) P P'  progress σ P φ j  progress σ P' φ j'"
proof (induction φ arbitrary: P P')
  case (Pred e ts)
  then show ?case
    by (force simp: rel_mapping_alt dom_def split: option.splits)
next
  case (Ands l)
  then show ?case
    by (auto simp: image_iff intro!: Min.coboundedI[THEN order_trans])
next
  case (Until φ I ψ)
  from Until(1,2)[of P P'] Until.prems show ?case
    by (cases "right I")
      (auto dest: trans_le_add1[OF τ_mono] intro!: cInf_superset_mono)
next
  case (MatchF I r)
  from MatchF(1)[of _ P P'] MatchF.prems show ?case
    by (cases "right I"; cases "regex.atms r = {}")
      (auto 0 3 simp: Min_le_iff progress_regex_def dest: trans_le_add1[OF τ_mono]
        intro!: cInf_superset_mono elim!: less_le_trans order_trans)
qed (force simp: Min_le_iff progress_regex_def split: option.splits)+

lemma rel_mapping_reflp: "reflp Q  rel_mapping Q P P"
  by (auto simp: rel_mapping_alt reflp_def)

lemmas progress_mono = progress_mono_gen[OF _ rel_mapping_reflp[unfolded reflp_def], simplified]

lemma progress_le_gen: "pred_mapping (λx. x  j) P  progress σ P φ j  j"
proof (induction φ arbitrary: P)
  case (Pred e ts)
  then show ?case
    by (auto simp: pred_mapping_alt dom_def split: option.splits)
next
  case (Ands l)
  then show ?case
    by (auto simp: image_iff intro!: Min.coboundedI[where a="progress σ P (hd l) j", THEN order_trans])
next
  case (Until φ I ψ)
  then show ?case
    by (cases "right I")
      (auto intro: trans_le_add1[OF τ_mono] intro!: cInf_lower)
next
  case (MatchF I r)
  then show ?case
    by (cases "right I")
      (auto intro: trans_le_add1[OF τ_mono] intro!: cInf_lower)
qed (force simp: Min_le_iff progress_regex_def split: option.splits)+

lemma progress_le: "progress σ Map.empty φ j  j"
  using progress_le_gen[of _ Map.empty] by auto

lemma progress_0_gen[simp]:
  "pred_mapping (λx. x = 0) P  progress σ P φ 0 = 0"
  using progress_le_gen[of 0 P] by auto

lemma progress_0[simp]:
  "progress σ Map.empty φ 0 = 0"
  by (auto simp: pred_mapping_alt)

definition max_mapping :: "('b  'a option)  ('b  'a option)  'b  ('a :: linorder) option" where
  "max_mapping P P' x = (case (P x, P' x) of
    (None, None)  None
  | (Some x, None)  None
  | (None, Some x)  None
  | (Some x, Some y)  Some (max x y))"

definition Max_mapping :: "('b  'a option) set  'b  ('a :: linorder) option" where
  "Max_mapping Ps x = (if (P  Ps. P x  None) then Some (Max ((λP. the (P x)) ` Ps)) else None)"

lemma dom_max_mapping[simp]: "dom (max_mapping P1 P2) = dom P1  dom P2"
  unfolding max_mapping_def by (auto split: option.splits)

lemma dom_Max_mapping[simp]: "dom (Max_mapping X) = (P  X. dom P)"
  unfolding Max_mapping_def by (auto split: if_splits)

lemma Max_mapping_coboundedI:
  assumes "finite X" "Q  X. dom Q = dom P" "P  X"
  shows "rel_mapping (≤) P (Max_mapping X)"
  unfolding rel_mapping_alt
proof (intro conjI ballI)
  from assms(3) have "X  {}" by auto
  then show "dom P = dom (Max_mapping X)" using assms(2) by auto
next
  fix p
  assume "p  dom P"
  with assms show "the (P p)  the (Max_mapping X p)"
    by (force simp add: Max_mapping_def intro!: Max.coboundedI imageI)
qed

lemma rel_mapping_trans: "P OO Q  R 
  rel_mapping P P1 P2  rel_mapping Q P2 P3  rel_mapping R P1 P3"
  by (force simp: rel_mapping_alt dom_def set_eq_iff)

abbreviation range_mapping :: "nat  nat  ('b  nat option)  bool" where
  "range_mapping i j P  pred_mapping (λx. i  x  x  j) P"

lemma range_mapping_relax:
  "range_mapping i j P  i'  i  j'  j  range_mapping i' j' P"
  by (auto simp: pred_mapping_alt dom_def set_eq_iff max_mapping_def split: option.splits)

lemma range_mapping_max_mapping[simp]:
  "range_mapping i j1 P1  range_mapping i j2 P2  range_mapping i (max j1 j2) (max_mapping P1 P2)"
  by (auto simp: pred_mapping_alt dom_def set_eq_iff max_mapping_def split: option.splits)

lemma range_mapping_Max_mapping[simp]:
  "finite X  X  {}  xX. range_mapping i (j x) (P x)  range_mapping i (Max (j ` X)) (Max_mapping (P ` X))"
  by (force simp: pred_mapping_alt Max_mapping_def dom_def image_iff
      intro!: Max_ge_iff[THEN iffD2] split: if_splits)

lemma pred_mapping_le:
  "pred_mapping ((≤) i) P1  rel_mapping (≤) P1 P2  pred_mapping ((≤) (i :: nat)) P2"
  by (force simp: rel_mapping_alt pred_mapping_alt dom_def set_eq_iff)

lemma pred_mapping_le':
  "pred_mapping ((≤) j) P1  i  j  rel_mapping (≤) P1 P2  pred_mapping ((≤) (i :: nat)) P2"
  by (force simp: rel_mapping_alt pred_mapping_alt dom_def set_eq_iff)

lemma max_mapping_cobounded1: "dom P1  dom P2  rel_mapping (≤) P1 (max_mapping P1 P2)"
  unfolding max_mapping_def rel_mapping_alt by (auto simp: dom_def split: option.splits)

lemma max_mapping_cobounded2: "dom P2  dom P1  rel_mapping (≤) P2 (max_mapping P1 P2)"
  unfolding max_mapping_def rel_mapping_alt by (auto simp: dom_def split: option.splits)

lemma max_mapping_fun_upd2[simp]:
  "max_mapping P1 (P2(p := y))(p  x) = (max_mapping P1 P2)(p  x)"
  by (auto simp: max_mapping_def)

lemma rel_mapping_max_mapping_fun_upd: "dom P2  dom P1  p  dom P2  the (P2 p)  y 
  rel_mapping (≤) P2 (max_mapping P1 P2(p  y))"
  by (auto simp: rel_mapping_alt max_mapping_def split: option.splits)

lemma progress_ge_gen: "Formula.future_bounded φ 
   P j. dom P = S  range_mapping i j P  i  progress σ P φ j"
proof (induction φ arbitrary: i S)
  case (Pred e ts)
  then show ?case
    by (intro exI[of _ "λe. if e  S then Some i else None"])
      (auto split: option.splits if_splits simp: rel_mapping_alt pred_mapping_alt dom_def)
next
  case (Let p φ ψ)
  from Let.prems obtain P2 j2 where P2: "dom P2 = insert p S" "range_mapping i j2 P2"
    "i  progress σ P2 ψ j2"
    by (atomize_elim, intro Let(2)) (force simp: pred_mapping_alt rel_mapping_alt dom_def)+
  from Let.prems obtain P1 j1 where P1: "dom P1 = S" "range_mapping (the (P2 p)) j1 P1"
    "the (P2 p)  progress σ P1 φ j1"
    by (atomize_elim, intro Let(1)) auto
  let ?P12 = "max_mapping P1 P2"
  from P1 P2 have le1: "progress σ P1 φ j1  progress σ (?P12(p := P1 p)) φ (max j1 j2)"
    by (intro progress_mono_gen) (auto simp: rel_mapping_alt max_mapping_def)
  from P1 P2 have le2: "progress σ P2 ψ j2  progress σ (?P12(p  progress σ P1 φ j1)) ψ (max j1 j2)"
    by (intro progress_mono_gen) (auto simp: rel_mapping_alt max_mapping_def)
  show ?case
    unfolding progress.simps
  proof (intro exI[of _ "?P12(p := P1 p)"] exI[of _ "max j1 j2"] conjI)
    show "dom (?P12(p := P1 p)) = S"
      using P1 P2 by (auto simp: dom_def max_mapping_def)
  next
    show "range_mapping i (max j1 j2) (?P12(p := P1 p))"
      using P1 P2 by (force simp add: pred_mapping_alt dom_def max_mapping_def split: option.splits)
  next
    have "i  progress σ P2 ψ j2" by fact
    also have "...  progress σ (?P12(p  progress σ P1 φ j1)) ψ (max j1 j2)"
      using le2 by blast
    also have "...  progress σ (?P12(p := P1 p)(pprogress σ (?P12(p := P1 p)) φ (max j1 j2))) ψ (max j1 j2)"
      by (auto intro!: progress_mono_gen simp: le1 rel_mapping_alt)
    finally show "i  ..." .
  qed
next
  case (Eq _ _)
  then show ?case
    by (intro exI[of _ "λe. if e  S then Some i else None"]) (auto split: if_splits simp: pred_mapping_alt)
next
  case (Less _ _)
  then show ?case
    by (intro exI[of _ "λe. if e  S then Some i else None"]) (auto split: if_splits simp: pred_mapping_alt)
next
  case (LessEq _ _)
  then show ?case
    by (intro exI[of _ "λe. if e  S then Some i else None"]) (auto split: if_splits simp: pred_mapping_alt)
next
  case (Or φ1 φ2)
  from Or(3) obtain P1 j1 where P1: "dom P1 = S" "range_mapping i j1 P1"  "i  progress σ P1 φ1 j1"
    using Or(1)[of S i] by auto
  moreover
  from Or(3) obtain P2 j2 where P2: "dom P2 = S" "range_mapping i j2 P2" "i  progress σ P2 φ2 j2"
    using Or(2)[of S i] by auto
  ultimately have "i  progress σ (max_mapping P1 P2) (Formula.Or φ1 φ2) (max j1 j2)"
    by (auto 0 3 elim!: order.trans[OF _ progress_mono_gen] intro: max_mapping_cobounded1 max_mapping_cobounded2)
  with P1 P2 show ?case by (intro exI[of _ "max_mapping P1 P2"] exI[of _ "max j1 j2"]) auto
next
  case (And φ1 φ2)
  from And(3) obtain P1 j1 where P1: "dom P1 = S" "range_mapping i j1 P1"  "i  progress σ P1 φ1 j1"
    using And(1)[of S i] by auto
  moreover
  from And(3) obtain P2 j2 where P2: "dom P2 = S" "range_mapping i j2 P2" "i  progress σ P2 φ2 j2"
    using And(2)[of S i] by auto
  ultimately have "i  progress σ (max_mapping P1 P2) (Formula.And φ1 φ2) (max j1 j2)"
    by (auto 0 3 elim!: order.trans[OF _ progress_mono_gen] intro: max_mapping_cobounded1 max_mapping_cobounded2)
  with P1 P2 show ?case by (intro exI[of _ "max_mapping P1 P2"] exI[of _ "max j1 j2"]) auto
next
  case (Ands l)
  show ?case proof (cases "l = []")
    case True
    then show ?thesis
      by (intro exI[of _ "λe. if e  S then Some i else None"])
        (auto split: if_splits simp: pred_mapping_alt)
  next
    case False
    then obtain φ where "φ  set l" by (cases l) auto
    from Ands.prems have "φset l. Formula.future_bounded φ"
      by (simp add: list.pred_set)
    { fix φ
      assume "φ  set l"
      with Ands.prems obtain P j where "dom P = S" "range_mapping i j P" "i  progress σ P φ j"
        by (atomize_elim, intro Ands(1)[of φ S i]) (auto simp: list.pred_set)
      then have "Pj. dom (fst Pj) = S  range_mapping i (snd Pj) (fst Pj)  i  progress σ (fst Pj) φ (snd Pj)"
        (is "Pj. ?P Pj")
        by (intro exI[of _ "(P, j)"]) auto
    }
    then have "φset l. Pj. dom (fst Pj) = S  range_mapping i (snd Pj) (fst Pj)  i  progress σ (fst Pj) φ (snd Pj)"
      (is "φset l. Pj. ?P Pj φ")
      by blast
    with Ands(1) Ands.prems False have "Pjf. φset l. ?P (Pjf φ) φ"
      by (auto simp: Ball_def intro: choice)
    then obtain Pjf where Pjf: "φset l. ?P (Pjf φ) φ" ..
    define Pf where "Pf = fst o Pjf"
    define jf where "jf = snd o Pjf"
    have *: "dom (Pf φ) = S" "range_mapping i (jf φ) (Pf φ)" "i  progress σ (Pf φ) φ (jf φ)"
      if "φ  set l" for φ
      using Pjf[THEN bspec, OF that] unfolding Pf_def jf_def by auto
    with False show ?thesis
      unfolding progress.simps eq_False[THEN iffD2, OF False] if_False
      by ((subst Min_ge_iff; simp add: False),
          intro exI[where x="MAX φset l. jf φ"] exI[where x="Max_mapping (Pf ` set l)"]
          conjI ballI order.trans[OF *(3) progress_mono_gen] Max_mapping_coboundedI)
        (auto simp: False *[OF φ  set l] φ  set l)
  qed
next
  case (Exists φ)
  then show ?case by simp
next
  case (Prev I φ)
  then obtain P j where "dom P = S" "range_mapping i j P" "i  progress σ P φ j"
    by (atomize_elim, intro Prev(1)) (auto simp: pred_mapping_alt dom_def)
  with Prev(2) have
    "dom P = S  range_mapping i (max i j) P  i  progress σ P (formula.Prev I φ) (max i j)"
    by (auto simp: le_Suc_eq max_def pred_mapping_alt split: if_splits
        elim: order.trans[OF _ progress_mono])
  then show ?case by blast
next
  case (Next I φ)
  then obtain P j where "dom P = S" "range_mapping (Suc i) j P" "Suc i  progress σ P φ j"
    by (atomize_elim, intro Next(1)) (auto simp: pred_mapping_alt dom_def)
  then show ?case
    by (intro exI[of _ P] exI[of _ j]) (auto 0 3 simp: pred_mapping_alt dom_def)
next
  case (Since φ1 I φ2)
  from Since(3) obtain P1 j1 where P1: "dom P1 = S" "range_mapping i j1 P1"  "i  progress σ P1 φ1 j1"
    using Since(1)[of S i] by auto
  moreover
  from Since(3) obtain P2 j2 where P2: "dom P2 = S" "range_mapping i j2 P2" "i  progress σ P2 φ2 j2"
    using Since(2)[of S i] by auto
  ultimately have "i  progress σ (max_mapping P1 P2) (Formula.Since φ1 I φ2) (max j1 j2)"
    by (auto elim!: order.trans[OF _ progress_mono_gen] simp: max_mapping_cobounded1 max_mapping_cobounded2)
  with P1 P2 show ?case by (intro exI[of _ "max_mapping P1 P2"] exI[of _ "max j1 j2"])
      (auto elim!: pred_mapping_le intro: max_mapping_cobounded1)
next
  case (Until φ1 I φ2)
  from Until.prems obtain b where [simp]: "right I = enat b"
    by (cases "right I") (auto)
  obtain i' where "i < i'" and σ i + b + 1  τ σ i'"
    using ex_le_τ[where x=σ i + b + 1"] by (auto simp add: less_eq_Suc_le)
  then have 1: σ i + b < τ σ i'" by simp
  from Until.prems obtain P1 j1 where P1: "dom P1 = S" "range_mapping (Suc i') j1 P1" "Suc i'  progress σ P1 φ1 j1"
    by (atomize_elim, intro Until(1)) (auto simp: pred_mapping_alt dom_def)
  from Until.prems obtain P2 j2 where P2: "dom P2 = S" "range_mapping (Suc i') j2 P2" "Suc i'  progress σ P2 φ2 j2"
    by (atomize_elim, intro Until(2)) (auto simp: pred_mapping_alt dom_def)
  let ?P12 = "max_mapping P1 P2"
  have "i  progress σ ?P12 (Formula.Until φ1 I φ2) (max j1 j2)"
    unfolding progress.simps
  proof (intro cInf_greatest, goal_cases nonempty greatest)
    case nonempty
    then show ?case
      by (auto simp: trans_le_add1[OF τ_mono] intro!: exI[of _ "max j1 j2"])
  next
    case (greatest x)
    from P1(2,3) have "i' < j1"
      by (auto simp: less_eq_Suc_le intro!: progress_le_gen elim!: order.trans pred_mapping_mono_strong)
    then have "i' < max j1 j2" by simp
    have "progress σ P1 φ1 j1  progress σ ?P12 φ1 (max j1 j2)"
      using P1(1) P2(1) by (auto intro!: progress_mono_gen max_mapping_cobounded1)
    moreover have "progress σ P2 φ2 j2  progress σ ?P12 φ2 (max j1 j2)"
      using P1(1) P2(1) by (auto intro!: progress_mono_gen max_mapping_cobounded2)
    ultimately have "i'  min (progress σ ?P12 φ1 (max j1 j2)) (progress σ ?P12 φ2 (max j1 j2))"
      using P1(3) P2(3) by simp
    with greatest i' < max j1 j2 have σ i'  τ σ x + b"
      by simp
    with 1 have σ i < τ σ x" by simp
    then show ?case by (auto dest!: less_τD)
  qed
  with P1 P2 i < i' show ?case
    by (intro exI[of _ "max_mapping P1 P2"] exI[of _ "max j1 j2"]) (auto simp: range_mapping_relax)
next
  case (MatchP I r)
  then show ?case
  proof (cases "regex.atms r = {}")
    case True
    with MatchP.prems show ?thesis
      unfolding progress.simps
      by (intro exI[of _ "λe. if e  S then Some i else None"] exI[of _ i])
        (auto split: if_splits simp: pred_mapping_alt regex.pred_set)
  next
    case False
    define pick where "pick = (λφ. SOME Pj. dom (fst Pj) = S  range_mapping i (snd Pj) (fst Pj) 
       i  progress σ (fst Pj) φ (snd Pj))"
    let ?pickP = "fst o pick" let ?pickj = "snd o pick"
    from MatchP have pick: "φ  regex.atms r  dom (?pickP φ) = S 
      range_mapping i (?pickj φ) (?pickP φ)  i  progress σ (?pickP φ) φ (?pickj φ)" for φ
      unfolding pick_def o_def future_bounded.simps regex.pred_set
      by (intro someI_ex[where P = "λPj. dom (fst Pj) = S  range_mapping i (snd Pj) (fst Pj) 
         i  progress σ (fst Pj) φ (snd Pj)"]) auto
    with False show ?thesis
      unfolding progress.simps
      by (intro exI[of _ "Max_mapping (?pickP ` regex.atms r)"] exI[of _ "Max (?pickj ` regex.atms r)"])
        (auto simp: Max_mapping_coboundedI
          order_trans[OF pick[THEN conjunct2, THEN conjunct2] progress_mono_gen])
  qed
next
  case (MatchF I r)
  from MatchF.prems obtain b where [simp]: "right I = enat b"
    by auto
  obtain i' where i': "i < i'" σ i + b + 1  τ σ i'"
    using ex_le_τ[where x=σ i + b + 1"] by (auto simp add: less_eq_Suc_le)
  then have 1: σ i + b < τ σ i'" by simp
  have ix: "i  x" if σ i'  b + τ σ x" "b + τ σ i < τ σ i'" for x
    using less_τD[of σ i] that less_le_trans by fastforce
  show ?case
  proof (cases "regex.atms r = {}")
    case True
    with MatchF.prems i' ix show ?thesis
      unfolding progress.simps
      by (intro exI[of _ "λe. if e  S then Some (Suc i') else None"] exI[of _ "Suc i'"])
        (auto split: if_splits simp: pred_mapping_alt regex.pred_set add.commute less_Suc_eq
          intro!: cInf_greatest dest!: spec[of _ i'] less_imp_le[THEN τ_mono, of _ i' σ])
  next
    case False
    then obtain φ where φ: "φ  regex.atms r" by auto
    define pick where "pick = (λφ. SOME Pj. dom (fst Pj) = S  range_mapping (Suc i') (snd Pj) (fst Pj) 
      Suc i'  progress σ (fst Pj) φ (snd Pj))"
    define pickP where "pickP = fst o pick" define pickj where "pickj = snd o pick"
    from MatchF have pick: "φ  regex.atms r  dom (pickP φ) = S 
    range_mapping (Suc i') (pickj φ) (pickP φ)  Suc i'  progress σ (pickP φ) φ (pickj φ)" for φ
      unfolding pick_def o_def future_bounded.simps regex.pred_set pickj_def pickP_def
      by (intro someI_ex[where P = "λPj. dom (fst Pj) = S  range_mapping (Suc i') (snd Pj) (fst Pj) 
       Suc i'  progress σ (fst Pj) φ (snd Pj)"]) auto
    let ?P = "Max_mapping (pickP ` regex.atms r)" let ?j = "Max (pickj ` regex.atms r)"
    from pick[OF φ] False φ have "Suc i'  ?j"
      by (intro order_trans[OF pick[THEN conjunct2, THEN conjunct2], OF φ] order_trans[OF progress_le_gen])
        (auto simp: Max_ge_iff dest: range_mapping_relax[of _ _ _ 0, OF _ _ order_refl, simplified])
    moreover
    note i' 1 ix
    moreover
    from MatchF.prems have "Regex.pred_regex Formula.future_bounded r"
      by auto
    ultimately show ?thesis using τ_mono[of _ ?j σ] less_τD[of σ i] pick False
      by (intro exI[of _ "?j"]  exI[of _ "?P"])
        (auto 0 3 intro!: cInf_greatest
          order_trans[OF le_SucI[OF order_refl] order_trans[OF pick[THEN conjunct2, THEN conjunct2] progress_mono_gen]]
          range_mapping_Max_mapping[OF _ _ ballI[OF range_mapping_relax[of "Suc i'" _ _ i, OF _ _ order_refl]]]
          simp: ac_simps Suc_le_eq trans_le_add2 Max_mapping_coboundedI progress_regex_def
          dest: spec[of _ "i'"] spec[of _ ?j])
  qed
qed (auto split: option.splits)

lemma progress_ge: "Formula.future_bounded φ  j. i  progress σ Map.empty φ j"
  using progress_ge_gen[of φ "{}" i σ]
  by auto

lemma cInf_restrict_nat:
  fixes x :: nat
  assumes "x  A"
  shows "Inf A = Inf {y  A. y  x}"
  using assms by (auto intro!: antisym intro: cInf_greatest cInf_lower Inf_nat_def1)

lemma progress_time_conv:
  assumes "i<j. τ σ i = τ σ' i"
  shows "progress σ P φ j = progress σ' P φ j"
  using assms proof (induction φ arbitrary: P)
  case (Until φ1 I φ2)
  have *: "i  j - 1  i < j" if "j  0" for i
    using that by auto
  with Until show ?case
  proof (cases "right I")
    case (enat b)
    then show ?thesis
    proof (cases "j")
      case (Suc n)
      with enat * Until show ?thesis
        using τ_mono[THEN trans_le_add1]
        by (auto 8 0
            intro!: box_equals[OF arg_cong[where f=Inf]
              cInf_restrict_nat[symmetric, where x=n] cInf_restrict_nat[symmetric, where x=n]])
    qed simp
  qed simp
next
  case (MatchF I r)
  have *: "i  j - 1  i < j" if "j  0" for i
    using that by auto
  with MatchF show ?case using τ_mono[THEN trans_le_add1]
    by (cases "right I"; cases j)
      ((auto 6 0 simp: progress_le_gen progress_regex_def intro!: box_equals[OF arg_cong[where f=Inf]
            cInf_restrict_nat[symmetric, where x="j-1"] cInf_restrict_nat[symmetric, where x="j-1"]]) [])+
qed (auto simp: progress_regex_def)

lemma Inf_UNIV_nat: "(Inf UNIV :: nat) = 0"
  by (simp add: cInf_eq_minimum)

lemma progress_prefix_conv:
  assumes "prefix_of π σ" and "prefix_of π σ'"
  shows "progress σ P φ (plen π) = progress σ' P φ (plen π)"
  using assms by (auto intro: progress_time_conv τ_prefix_conv)

lemma bounded_rtranclp_mono:
  fixes n :: "'x :: linorder"
  assumes "i j. R i j  j < n  S i j" "i j. R i j  i  j"
  shows "rtranclp R i j  j < n  rtranclp S i j"
proof (induct rule: rtranclp_induct)
  case (step y z)
  then show ?case
    using assms(1,2)[of y z]
    by (auto elim!: rtrancl_into_rtrancl[to_pred, rotated])
qed auto

lemma sat_prefix_conv_gen:
  assumes "prefix_of π σ" and "prefix_of π σ'"
  shows "i < progress σ P φ (plen π)  dom V = dom V'  dom P = dom V 
    pred_mapping (λx. x  plen π) P 
    (p i φ. p  dom V  i < the (P p)  the (V p) i = the (V' p) i) 
    Formula.sat σ V v i φ  Formula.sat σ' V' v i φ"
proof (induction φ arbitrary: P V V' v i)
  case (Pred e ts)
  from Pred.prems(1,4) have "i < plen π"
    by (blast intro!: order.strict_trans2 progress_le_gen)
  show ?case proof (cases "V e")
    case None
    then have "V' e = None" using ‹dom V = dom V' by auto
    with None Γ_prefix_conv[OF assms(1,2) i < plen π] show ?thesis by simp
  next
    case (Some a)
    obtain a' where "V' e = Some a'" using Some ‹dom V = dom V' by auto
    then have "i < the (P e)"
      using Pred.prems(1-3) by (auto split: option.splits)
    then have "the (V e) i = the (V' e) i"
      using Some by (intro Pred.prems(5)) (simp_all add: domI)
    with Some V' e = Some a' show ?thesis by simp
  qed
next
  case (Let p φ ψ)
  let ?V = "λV σ. (V(p  λi. {v. length v = Formula.nfv φ  Formula.sat σ V v i φ}))"
  show ?case unfolding sat.simps proof (rule Let.IH(2))
    from Let.prems show "i < progress σ (P(p  progress σ P φ (plen π))) ψ (plen π)"
      by simp
    from Let.prems show "dom (?V V σ) = dom (?V V' σ')"
      by simp
    from Let.prems show "dom (P(p  progress σ P φ (plen π))) = dom (?V V σ)"
      by simp
    from Let.prems show "pred_mapping (λx. x  plen π) (P(p  progress σ P φ (plen π)))"
      by (auto intro!: pred_mapping_map_upd elim!: progress_le_gen)
  next
    fix p' i φ'
    assume 1: "p'  dom (?V V σ)" and 2: "i < the ((P(p  progress σ P φ (plen π))) p')"
    show "the (?V V σ p') i = the (?V V' σ' p') i" proof (cases "p' = p")
      case True
      with Let 2 show ?thesis by auto
    next
      case False
      with 1 2 show ?thesis by (auto intro!: Let.prems(5))
    qed
  qed
next
  case (Eq t1 t2)
  show ?case by simp
next
  case (Neg φ)
  then show ?case by simp
next
  case (Or φ1 φ2)
  then show ?case by auto
next
  case (Ands l)
  from Ands.prems have "φset l. i < progress σ P φ (plen π)"
    by (cases l) simp_all
  with Ands show ?case unfolding sat_Ands by blast
next
  case (Exists φ)
  then show ?case by simp
next
  case (Prev I φ)
  with τ_prefix_conv[OF assms(1,2)] show ?case
    by (cases i) (auto split: if_splits)
next
  case (Next I φ)
  then have "Suc i < plen π"
    by (auto intro: order.strict_trans2[OF _ progress_le_gen[of _ P σ φ]])
  with Next.prems τ_prefix_conv[OF assms(1,2)] show ?case
    unfolding sat.simps
    by (intro conj_cong Next) auto
next
  case (Since φ1 I φ2)
  then have "i < plen π"
    by (auto elim!: order.strict_trans2[OF _ progress_le_gen])
  with Since.prems τ_prefix_conv[OF assms(1,2)] show ?case
    unfolding sat.simps
    by (intro conj_cong ex_cong ball_cong Since) auto
next
  case (Until φ1 I φ2)
  from Until.prems obtain b where right[simp]: "right I = enat b"
    by (cases "right I") (auto simp add: Inf_UNIV_nat)
  from Until.prems obtain j where σ i + b + 1  τ σ j"
    "j  progress σ P φ1 (plen π)" "j  progress σ P φ2 (plen π)"
    by atomize_elim (auto 0 4 simp add: less_eq_Suc_le not_le intro: Suc_leI dest: spec[of _ "i"]
        dest!: le_cInf_iff[THEN iffD1, rotated -1])
  then have 1: "k < progress σ P φ1 (plen π)" and 2: "k < progress σ P φ2 (plen π)"
    if σ k  τ σ i + b" for k
    using that by (fastforce elim!: order.strict_trans2[rotated] intro: less_τD[of σ])+
  have 3: "k < plen π" if σ k  τ σ i + b" for k
    using 1[OF that] Until(6) by (auto simp only: less_eq_Suc_le order.trans[OF _ progress_le_gen])

  from Until.prems have "i < progress σ' P (Formula.Until φ1 I φ2) (plen π)"
    unfolding progress_prefix_conv[OF assms(1,2)] by blast
  then obtain j where σ' i + b + 1  τ σ' j"
    "j  progress σ' P φ1 (plen π)" "j  progress σ' P φ2 (plen π)"
    by atomize_elim (auto 0 4 simp add: less_eq_Suc_le not_le intro: Suc_leI dest: spec[of _ "i"]
        dest!: le_cInf_iff[THEN iffD1, rotated -1])
  then have 11: "k < progress σ P φ1 (plen π)" and 21: "k < progress σ P φ2 (plen π)"
    if σ' k  τ σ' i + b" for k
    unfolding progress_prefix_conv[OF assms(1,2)]
    using that by (fastforce elim!: order.strict_trans2[rotated] intro: less_τD[of σ'])+
  have 31: "k < plen π" if σ' k  τ σ' i + b" for k
    using 11[OF that] Until(6) by (auto simp only: less_eq_Suc_le order.trans[OF _ progress_le_gen])
  show ?case unfolding sat.simps
  proof ((intro ex_cong iffI; elim conjE), goal_cases LR RL)
    case (LR j)
    with Until(1)[OF 1] Until(2)[OF 2] τ_prefix_conv[OF assms(1,2) 3] Until.prems show ?case
      by (auto 0 4 simp: le_diff_conv add.commute dest: less_imp_le order.trans[OF τ_mono, rotated])
  next
    case (RL j)
    with Until(1)[OF 11] Until(2)[OF 21] τ_prefix_conv[OF assms(1,2) 31] Until.prems show ?case
      by (auto 0 4 simp: le_diff_conv add.commute dest: less_imp_le order.trans[OF τ_mono, rotated])
  qed
next
  case (MatchP I r)
  then have "i < plen π"
    by (force simp: pred_mapping_alt elim!: order.strict_trans2[OF _ progress_le_gen])
  with MatchP.prems τ_prefix_conv[OF assms(1,2)] show ?case
    unfolding sat.simps
    by (intro ex_cong conj_cong match_cong_strong MatchP) (auto simp: progress_regex_def split: if_splits)
next
  case (MatchF I r)
  from MatchF.prems obtain b where right[simp]: "right I = enat b"
    by (cases "right I") (auto simp add: Inf_UNIV_nat)
  show ?case
  proof (cases "regex.atms r = {}")
    case True
    from MatchF.prems(1) obtain j where σ i + b + 1  τ σ j" "j  plen π"
      by atomize_elim (auto 0 4 simp add: less_eq_Suc_le not_le dest!: le_cInf_iff[THEN iffD1, rotated -1])
    then have 1: "k < plen π" if σ k  τ σ i + b" for k
      by (meson τ_mono discrete not_le order.strict_trans2 that)
    from MatchF.prems have "i < progress σ' P (Formula.MatchF I r) (plen π)"
      unfolding progress_prefix_conv[OF assms(1,2)] by blast
    then obtain j where σ' i + b + 1  τ σ' j" "j  plen π"
      by atomize_elim (auto 0 4 simp add: less_eq_Suc_le not_le dest!: le_cInf_iff[THEN iffD1, rotated -1])
    then have 2: "k < plen π" if σ' k  τ σ' i + b" for k
      by (meson τ_mono discrete not_le order.strict_trans2 that)
    from MatchF.prems(1,4) True show ?thesis
      unfolding sat.simps conj_commute[of "left I  _" "_  _"]
    proof (intro ex_cong conj_cong match_cong_strong, goal_cases left right sat)
      case (left j)
      then show ?case
        by (intro iffI)
          ((subst (1 2) τ_prefix_conv[OF assms(1,2) 1, symmetric]; auto elim: order.trans[OF τ_mono, rotated]),
            (subst (1 2) τ_prefix_conv[OF assms(1,2) 2]; auto elim: order.trans[OF τ_mono, rotated]))
    next
      case (right j)
      then show ?case
        by (intro iffI)
          ((subst (1 2) τ_prefix_conv[OF assms(1,2) 2, symmetric]; auto elim: order.trans[OF τ_mono, rotated]),
            (subst (1 2) τ_prefix_conv[OF assms(1,2) 2]; auto elim: order.trans[OF τ_mono, rotated]))
    qed auto
  next
    case False
    from MatchF.prems(1) False obtain j where σ i + b + 1  τ σ j" "(xregex.atms r. j  progress σ P x (plen π))"
      by atomize_elim (auto 0 6 simp add: less_eq_Suc_le not_le progress_regex_def
        dest!: le_cInf_iff[THEN iffD1, rotated -1])
    then have 1: "φ  regex.atms r  k < progress σ P φ (plen π)" if σ k  τ σ i + b" for k φ
      using that
      by (fastforce elim!: order.strict_trans2[rotated] intro: less_τD[of σ])
    then have 2: "k < plen π" if σ k  τ σ i + b" "regex.atms r  {}" for k
      using that
      by (fastforce intro: order.strict_trans2[OF _ progress_le_gen[OF MatchF(5), of σ], of k])

    from MatchF.prems have "i < progress σ' P (Formula.MatchF I r) (plen π)"
      unfolding progress_prefix_conv[OF assms(1,2)] by blast
    with False obtain j where σ' i + b + 1  τ σ' j" "(xregex.atms r. j  progress σ' P x (plen π))"
      by atomize_elim (auto 0 6 simp add: less_eq_Suc_le not_le progress_regex_def
        dest!: le_cInf_iff[THEN iffD1, rotated -1])
    then have 11:  "φ  regex.atms r  k < progress σ P φ (plen π)" if σ' k  τ σ' i + b" for k φ
      using that using progress_prefix_conv[OF assms(1,2)]
      by (auto 0 3 elim!: order.strict_trans2[rotated] intro: less_τD[of σ'])
    have 21: "k < plen π" if σ' k  τ σ' i + b" for k
      using 11[OF that(1)] False by (fastforce intro: order.strict_trans2[OF _ progress_le_gen[OF MatchF(5), of σ], of k])
    show ?thesis unfolding sat.simps conj_commute[of "left I  _" "_  _"]
    proof ((intro ex_cong conj_cong match_cong_strong MatchF(1)[OF _ _ MatchF(3-6)]; assumption?), goal_cases right left progress)
      case (right j)
      with False show ?case
        by (intro iffI)
          ((subst (1 2) τ_prefix_conv[OF assms(1,2) 2, symmetric]; auto elim: order.trans[OF τ_mono, rotated]),
            (subst (1 2) τ_prefix_conv[OF assms(1,2) 21]; auto elim: order.trans[OF τ_mono, rotated]))
    next
      case (left j)
      with False show ?case unfolding right enat_ord_code le_diff_conv add.commute[of b]
        by (intro iffI)
          ((subst (1 2) τ_prefix_conv[OF assms(1,2) 21, symmetric]; auto elim: order.trans[OF τ_mono, rotated]),
            (subst (1 2) τ_prefix_conv[OF assms(1,2) 21]; auto elim: order.trans[OF τ_mono, rotated]))
    next
      case (progress j k z)
      with False show ?case unfolding right enat_ord_code le_diff_conv add.commute[of b]
        by (elim 1[rotated])
          (subst (1 2) τ_prefix_conv[OF assms(1,2) 21]; auto elim!: order.trans[OF τ_mono, rotated])
    qed
  qed
qed auto

lemma sat_prefix_conv:
  assumes "prefix_of π σ" and "prefix_of π σ'"
  shows "i < progress σ Map.empty φ (plen π) 
    Formula.sat σ Map.empty v i φ  Formula.sat σ' Map.empty v i φ"
  by (erule sat_prefix_conv_gen[OF assms]) auto

lemma progress_remove_neg[simp]: "progress σ P (remove_neg φ) j = progress σ P φ j"
  by (cases φ) simp_all

lemma safe_progress_get_and: "safe_formula φ 
  Min ((λφ. progress σ P φ j) ` set (get_and_list φ)) = progress σ P φ j"
  by (induction φ rule: get_and_list.induct) auto

lemma progress_convert_multiway: "safe_formula φ  progress σ P (convert_multiway φ) j = progress σ P φ j"
proof (induction φ arbitrary: P rule: safe_formula_induct)
  case (And_safe φ ψ)
  let ?c = "convert_multiway (Formula.And φ ψ)"
  let ?cφ = "convert_multiway φ"
  let ?cψ = "convert_multiway ψ"
  have c_eq: "?c = Formula.Ands (get_and_list ?cφ @ get_and_list ?cψ)"
    using And_safe by simp
  from ‹safe_formula φ have "safe_formula ?cφ" by (rule safe_convert_multiway)
  moreover from ‹safe_formula ψ have "safe_formula ?cψ" by (rule safe_convert_multiway)
  ultimately show ?case
    unfolding c_eq
    using And_safe.IH
    by (auto simp: get_and_nonempty Min.union safe_progress_get_and)
next
  case (And_Not φ ψ)
  let ?c = "convert_multiway (Formula.And φ (Formula.Neg ψ))"
  let ?cφ = "convert_multiway φ"
  let ?cψ = "convert_multiway ψ"
  have c_eq: "?c = Formula.Ands (Formula.Neg ?cψ # get_and_list ?cφ)"
    using And_Not by simp
  from ‹safe_formula φ have "safe_formula ?cφ" by (rule safe_convert_multiway)
  moreover from ‹safe_formula ψ have "safe_formula ?cψ" by (rule safe_convert_multiway)
  ultimately show ?case
    unfolding c_eq
    using And_Not.IH
    by (auto simp: get_and_nonempty Min.union safe_progress_get_and)
next
  case (MatchP I r)
  from MatchP show ?case
    unfolding progress.simps regex.map convert_multiway.simps regex.set_map image_image
    by (intro if_cong arg_cong[of _ _ Min] image_cong)
      (auto 0 4 simp: atms_def elim!: disjE_Not2 dest: safe_regex_safe_formula)
next
  case (MatchF I r)
  from MatchF show ?case
    unfolding progress.simps regex.map convert_multiway.simps regex.set_map image_image
    by (intro if_cong arg_cong[of _ _ Min] arg_cong[of _ _ Inf] arg_cong[of _ _ "(≤) _"]
      image_cong Collect_cong all_cong1 imp_cong conj_cong image_cong)
      (auto 0 4 simp: atms_def elim!: disjE_Not2 dest: safe_regex_safe_formula)
qed auto


subsection ‹Specification›

definition pprogress :: "Formula.formula  Formula.prefix  nat" where
  "pprogress φ π = (THE n. σ. prefix_of π σ  progress σ Map.empty φ (plen π) = n)"

lemma pprogress_eq: "prefix_of π σ  pprogress φ π = progress σ Map.empty φ (plen π)"
  unfolding pprogress_def using progress_prefix_conv
  by blast

locale future_bounded_mfodl =
  fixes φ :: Formula.formula
  assumes future_bounded: "Formula.future_bounded φ"

sublocale future_bounded_mfodl  sliceable_timed_progress "Formula.nfv φ" "Formula.fv φ" "relevant_events φ"
  "λσ v i. Formula.sat σ Map.empty v i φ" "pprogress φ"
proof (unfold_locales, goal_cases)
  case (1 x)
  then show ?case by (simp add: fvi_less_nfv)
next
  case (2 v v' σ i)
  then show ?case by (simp cong: sat_fv_cong[rule_format])
next
  case (3 v S σ i)
  then show ?case
    using sat_slice_iff[symmetric] by simp
next
  case (4 π π')
  moreover obtain σ where "prefix_of π' σ"
    using ex_prefix_of ..
  moreover have "prefix_of π σ"
    using prefix_of_antimono[OF π  π' ‹prefix_of π' σ] .
  ultimately show ?case
    by (simp add: pprogress_eq plen_mono progress_mono)
next
  case (5 σ x)
  obtain j where "x  progress σ Map.empty φ j"
    using future_bounded progress_ge by blast
  then have "x  pprogress φ (take_prefix j σ)"
    by (simp add: pprogress_eq[of _ σ])
  then show ?case by force
next
  case (6 π σ σ' i v)
  then have "i < progress σ Map.empty φ (plen π)"
    by (simp add: pprogress_eq)
  with 6 show ?case
    using sat_prefix_conv by blast
next
  case (7 π π')
  then have "plen π = plen π'"
    by transfer (simp add: list_eq_iff_nth_eq)
  moreover obtain σ σ' where "prefix_of π σ" "prefix_of π' σ'"
    using ex_prefix_of by blast+
  moreover have "i < plen π. τ σ i = τ σ' i"
    using 7 calculation
    by transfer (simp add: list_eq_iff_nth_eq)
  ultimately show ?case
    by (simp add: pprogress_eq progress_time_conv)
qed

locale verimon_spec =
  fixes φ :: Formula.formula
  assumes monitorable: "mmonitorable φ"

sublocale verimon_spec  future_bounded_mfodl
  using monitorable by unfold_locales (simp add: mmonitorable_def)


subsection ‹Correctness›

subsubsection ‹Invariants›

definition wf_mbuf2 :: "nat  nat  nat  (nat  event_data table  bool)  (nat  event_data table  bool) 
    event_data mbuf2  bool" where
  "wf_mbuf2 i ja jb P Q buf  i  ja  i  jb  (case buf of (xs, ys) 
    list_all2 P [i..<ja] xs  list_all2 Q [i..<jb] ys)"

inductive list_all3 :: "('a  'b  'c  bool)  'a list  'b list  'c list  bool" for P :: "('a  'b  'c  bool)" where
  "list_all3 P [] [] []"
| "P a1 a2 a3  list_all3 P q1 q2 q3  list_all3 P (a1 # q1) (a2 # q2) (a3 # q3)"

lemma list_all3_list_all2D: "list_all3 P xs ys zs 
  (length xs = length ys  list_all2 (case_prod P) (zip xs ys) zs)"
  by (induct xs ys zs rule: list_all3.induct) auto

lemma list_all2_list_all3I: "length xs = length ys  list_all2 (case_prod P) (zip xs ys) zs 
  list_all3 P xs ys zs"
  by (induct xs ys arbitrary: zs rule: list_induct2)
    (auto simp: list_all2_Cons1 intro: list_all3.intros)

lemma list_all3_list_all2_eq: "list_all3 P xs ys zs 
  (length xs = length ys  list_all2 (case_prod P) (zip xs ys) zs)"
  using list_all2_list_all3I list_all3_list_all2D by blast

lemma list_all3_mapD: "list_all3 P (map f xs) (map g ys) (map h zs) 
  list_all3 (λx y z. P (f x) (g y) (h z)) xs ys zs"
  by (induct "map f xs" "map g ys" "map h zs" arbitrary: xs ys zs rule: list_all3.induct)
    (auto intro: list_all3.intros)

lemma list_all3_mapI: "list_all3 (λx y z. P (f x) (g y) (h z)) xs ys zs 
  list_all3 P (map f xs) (map g ys) (map h zs)"
  by (induct xs ys zs rule: list_all3.induct)
    (auto intro: list_all3.intros)

lemma list_all3_map_iff: "list_all3 P (map f xs) (map g ys) (map h zs) 
  list_all3 (λx y z. P (f x) (g y) (h z)) xs ys zs"
  using list_all3_mapD list_all3_mapI by blast

lemmas list_all3_map =
  list_all3_map_iff[where g=id and h=id, unfolded list.map_id id_apply]
  list_all3_map_iff[where f=id and h=id, unfolded list.map_id id_apply]
  list_all3_map_iff[where f=id and g=id, unfolded list.map_id id_apply]

lemma list_all3_conv_all_nth:
  "list_all3 P xs ys zs =
  (length xs = length ys  length ys = length zs  (i < length xs. P (xs!i) (ys!i) (zs!i)))"
  by (auto simp add: list_all3_list_all2_eq list_all2_conv_all_nth)

lemma list_all3_refl [intro?]:
  "(x. x  set xs  P x x x)  list_all3 P xs xs xs"
  by (simp add: list_all3_conv_all_nth)

definition wf_mbufn :: "nat  nat list  (nat  event_data table  bool) list  event_data mbufn  bool" where
  "wf_mbufn i js Ps buf  list_all3 (λP j xs. i  j  list_all2 P [i..<j] xs) Ps js buf"

definition wf_mbuf2' :: "Formula.trace  _  _  nat  nat  event_data list set 
  Formula.formula  Formula.formula  event_data mbuf2  bool" where
  "wf_mbuf2' σ P V j n R φ ψ buf  wf_mbuf2 (min (progress σ P φ j) (progress σ P ψ j))
    (progress σ P φ j) (progress σ P ψ j)
    (λi. qtable n (Formula.fv φ) (mem_restr R) (λv. Formula.sat σ V (map the v) i φ))
    (λi. qtable n (Formula.fv ψ) (mem_restr R) (λv. Formula.sat σ V (map the v) i ψ)) buf"

definition wf_mbufn' :: "Formula.trace  _  _  nat  nat  event_data list set 
  Formula.formula Regex.regex  event_data mbufn  bool" where
  "wf_mbufn' σ  P V j n R r buf  (case to_mregex r of (mr, φs) 
    wf_mbufn (progress_regex σ P r j) (map (λφ. progress σ P φ j) φs)
    (map (λφ i. qtable n (Formula.fv φ) (mem_restr R) (λv. Formula.sat σ V (map the v) i φ)) φs)
    buf)"

lemma wf_mbuf2'_UNIV_alt: "wf_mbuf2' σ P V j n UNIV φ ψ buf  (case buf of (xs, ys) 
  list_all2 (λi. wf_table n (Formula.fv φ) (λv. Formula.sat σ V (map the v) i φ))
    [min (progress σ P φ j) (progress σ P ψ j) ..< (progress σ P φ j)] xs 
  list_all2 (λi. wf_table n (Formula.fv ψ) (λv. Formula.sat σ V (map the v) i ψ))
    [min (progress σ P φ j) (progress σ P ψ j) ..< (progress σ P ψ j)] ys)"
  unfolding wf_mbuf2'_def wf_mbuf2_def
  by (simp add: mem_restr_UNIV[THEN eqTrueI, abs_def] split: prod.split)

definition wf_ts :: "Formula.trace  _  nat  Formula.formula  Formula.formula  ts list  bool" where
  "wf_ts σ P j φ ψ ts  list_all2 (λi t. t = τ σ i) [min (progress σ P φ j) (progress σ P ψ j)..<j] ts"

definition wf_ts_regex :: "Formula.trace  _  nat  Formula.formula Regex.regex  ts list  bool" where
  "wf_ts_regex σ P j r ts  list_all2 (λi t. t = τ σ i) [progress_regex σ P r j..<j] ts"

abbreviation "Sincep pos φ I ψ  Formula.Since (if pos then φ else Formula.Neg φ) I ψ"

definition (in msaux) wf_since_aux :: "Formula.trace  _  event_data list set  args 
  Formula.formula  Formula.formula  'msaux  nat  bool" where
  "wf_since_aux σ V R args φ ψ aux ne  Formula.fv φ  Formula.fv ψ  (cur auxlist. valid_msaux args cur aux auxlist 
    cur = (if ne = 0 then 0 else τ σ (ne - 1)) 
    sorted_wrt (λx y. fst x > fst y) auxlist 
    (t X. (t, X)  set auxlist  ne  0  t  τ σ (ne - 1)  τ σ (ne - 1) - t  right (args_ivl args)  (i. τ σ i = t) 
      qtable (args_n args) (Formula.fv ψ) (mem_restr R) (λv. Formula.sat σ V (map the v) (ne-1) (Sincep (args_pos args) φ (point (τ σ (ne - 1) - t)) ψ)) X) 
    (t. ne  0  t  τ σ (ne - 1)  τ σ (ne - 1) - t  right (args_ivl args)  (i. τ σ i = t) 
      (X. (t, X)  set auxlist)))"

definition wf_matchP_aux :: "Formula.trace  _  nat  event_data list set  Formula.formula Regex.regex  event_data mrδaux  nat  bool" where
  "wf_matchP_aux σ V n R I r aux ne  sorted_wrt (λx y. fst x > fst y) aux 
    (t X. (t, X)  set aux  ne  0  t  τ σ (ne-1)  τ σ (ne-1) - t  right I  (i. τ σ i = t) 
      (case to_mregex r of (mr, φs) 
      (ms  RPDs mr. qtable n (Formula.fv_regex r) (mem_restr R) (λv. Formula.sat σ V (map the v) (ne-1)
         (Formula.MatchP (point (τ σ (ne-1) - t)) (from_mregex ms φs)))
         (lookup X ms)))) 
    (t. ne  0  t  τ σ (ne-1)  τ σ (ne-1) - t  right I  (i. τ σ i = t) 
      (X. (t, X)  set aux))"

lemma qtable_mem_restr_UNIV: "qtable n A(mem_restr UNIV) Q X = wf_table n A Q X"
  unfolding qtable_def by auto

lemma (in msaux) wf_since_aux_UNIV_alt:
  "wf_since_aux σ V UNIV args φ ψ aux ne  Formula.fv φ  Formula.fv ψ  (cur auxlist. valid_msaux args cur aux auxlist 
    cur = (if ne = 0 then 0 else τ σ (ne - 1)) 
    sorted_wrt (λx y. fst x > fst y) auxlist 
    (t X. (t, X)  set auxlist  ne  0  t  τ σ (ne - 1)  τ σ (ne - 1) - t  right (args_ivl args)  (i. τ σ i = t) 
      wf_table (args_n args) (Formula.fv ψ)
          (λv. Formula.sat σ V (map the v) (ne - 1) (Sincep (args_pos args) φ (point (τ σ (ne - 1) - t)) ψ)) X) 
    (t. ne  0  t  τ σ (ne - 1)  τ σ (ne - 1) - t  right (args_ivl args)  (i. τ σ i = t) 
      (X. (t, X)  set auxlist)))"
  unfolding wf_since_aux_def qtable_mem_restr_UNIV ..

definition wf_until_auxlist :: "Formula.trace  _  nat  event_data list set  bool 
    Formula.formula  Formula.formula  event_data muaux  nat  bool" where
  "wf_until_auxlist σ V n R pos φ I ψ auxlist ne 
    list_all2 (λx i. case x of (t, r1, r2)  t = τ σ i 
      qtable n (Formula.fv φ) (mem_restr R) (λv. if pos then (k{i..<ne+length auxlist}. Formula.sat σ V (map the v) k φ)
          else (k{i..<ne+length auxlist}. Formula.sat σ V (map the v) k φ)) r1 
      qtable n (Formula.fv ψ) (mem_restr R) (λv. (j. i  j  j < ne + length auxlist  mem (τ σ j - τ σ i) I 
          Formula.sat σ V (map the v) j ψ 
          (k{i..<j}. if pos then Formula.sat σ V (map the v) k φ else ¬ Formula.sat σ V (map the v) k φ))) r2)
      auxlist [ne..<ne+length auxlist]"

definition (in muaux) wf_until_aux :: "Formula.trace  _  event_data list set  args 
  Formula.formula  Formula.formula  'muaux  nat  bool" where
  "wf_until_aux σ V R args φ ψ aux ne  Formula.fv φ  Formula.fv ψ 
    (cur auxlist. valid_muaux args cur aux auxlist 
      cur = (if ne + length auxlist = 0 then 0 else τ σ (ne + length auxlist - 1)) 
      wf_until_auxlist σ V (args_n args) R (args_pos args) φ (args_ivl args) ψ auxlist ne)"

lemma (in muaux) wf_until_aux_UNIV_alt:
  "wf_until_aux σ V UNIV args φ ψ aux ne  Formula.fv φ  Formula.fv ψ 
    (cur auxlist. valid_muaux args cur aux auxlist 
      cur = (if ne + length auxlist = 0 then 0 else τ σ (ne + length auxlist - 1)) 
      list_all2 (λx i. case x of (t, r1, r2)  t = τ σ i 
      wf_table (args_n args) (Formula.fv φ) (λv. if (args_pos args)
          then (k{i..<ne+length auxlist}. Formula.sat σ V (map the v) k φ)
          else (k{i..<ne+length auxlist}. Formula.sat σ V (map the v) k φ)) r1 
      wf_table (args_n args) (Formula.fv ψ) (λv. j. i  j  j < ne + length auxlist  mem (τ σ j - τ σ i) (args_ivl args) 
          Formula.sat σ V (map the v) j ψ 
          (k{i..<j}. if (args_pos args) then Formula.sat σ V (map the v) k φ else ¬ Formula.sat σ V (map the v) k φ)) r2)
      auxlist [ne..<ne+length auxlist])"
  unfolding wf_until_aux_def wf_until_auxlist_def qtable_mem_restr_UNIV ..

definition wf_matchF_aux :: "Formula.trace  _  nat  event_data list set  Formula.formula Regex.regex  event_data mlδaux  nat  nat  bool" where
  "wf_matchF_aux σ V n R I r aux ne k  (case to_mregex r of (mr, φs) 
      list_all2 (λx i. case x of (t, rels, rel)  t = τ σ i 
        list_all2 (λφ. qtable n (Formula.fv φ) (mem_restr R) (λv.
          Formula.sat σ V (map the v) i φ)) φs rels 
        qtable n (Formula.fv_regex r) (mem_restr R) (λv. (j. i  j  j < ne + length aux + k  mem (τ σ j - τ σ i) I 
          Regex.match (Formula.sat σ V (map the v)) r i j)) rel)
    aux [ne..<ne+length aux])"

definition wf_matchF_invar where
  "wf_matchF_invar σ V n R I r st i =
     (case st of (aux, Y)  aux  []  wf_matchF_aux σ V n R I r aux i 0 
     (case to_mregex r of (mr, φs)  ms  LPDs mr.
       qtable n (Formula.fv_regex r) (mem_restr R) (λv.
         Regex.match (Formula.sat σ V (map the v)) (from_mregex ms φs) i (i + length aux - 1)) (lookup Y ms)))"

definition lift_envs' :: "nat  event_data list set  event_data list set" where
  "lift_envs' b R = (λ(xs,ys). xs @ ys) ` ({xs. length xs = b} × R)"

fun formula_of_constraint :: "Formula.trm × bool × mconstraint × Formula.trm  Formula.formula" where
  "formula_of_constraint (t1, True, MEq, t2) = Formula.Eq t1 t2"
| "formula_of_constraint (t1, True, MLess, t2) = Formula.Less t1 t2"
| "formula_of_constraint (t1, True, MLessEq, t2) = Formula.LessEq t1 t2"
| "formula_of_constraint (t1, False, MEq, t2) = Formula.Neg (Formula.Eq t1 t2)"
| "formula_of_constraint (t1, False, MLess, t2) = Formula.Neg (Formula.Less t1 t2)"
| "formula_of_constraint (t1, False, MLessEq, t2) = Formula.Neg (Formula.LessEq t1 t2)"

inductive (in maux) wf_mformula :: "Formula.trace  nat  _  _ 
  nat  event_data list set  ('msaux, 'muaux) mformula  Formula.formula  bool"
  for σ j where
    Eq: "is_simple_eq t1 t2 
    xFormula.fv_trm t1. x < n  xFormula.fv_trm t2. x < n 
    wf_mformula σ j P V n R (MRel (eq_rel n t1 t2)) (Formula.Eq t1 t2)"
  | neq_Var: "x < n 
    wf_mformula σ j P V n R (MRel empty_table) (Formula.Neg (Formula.Eq (Formula.Var x) (Formula.Var x)))"
  | Pred: "xFormula.fv (Formula.Pred e ts). x < n 
    tset ts. Formula.is_Var t  Formula.is_Const t 
    wf_mformula σ j P V n R (MPred e ts) (Formula.Pred e ts)"
  | Let: "wf_mformula σ j P V m UNIV φ φ' 
    wf_mformula σ j (P(p  progress σ P φ' j))
      (V(p  λi. {v. length v = m  Formula.sat σ V v i φ'})) n R ψ ψ' 
    {0..<m}  Formula.fv φ'  b  m  m = Formula.nfv φ' 
    wf_mformula σ j P V n R (MLet p m φ ψ) (Formula.Let p φ' ψ')"
  | And: "wf_mformula σ j P V n R φ φ'  wf_mformula σ j P V n R ψ ψ' 
    if pos then χ = Formula.And φ' ψ'
      else χ = Formula.And φ' (Formula.Neg ψ')  Formula.fv ψ'  Formula.fv φ' 
    wf_mbuf2' σ P V j n R φ' ψ' buf 
    wf_mformula σ j P V n R (MAnd (fv φ') φ pos (fv ψ') ψ buf) χ"
  | AndAssign: "wf_mformula σ j P V n R φ φ' 
    x < n  x  Formula.fv φ'  Formula.fv_trm t  Formula.fv φ'  (x, t) = conf 
    ψ' = Formula.Eq (Formula.Var x) t  ψ' = Formula.Eq t (Formula.Var x) 
    wf_mformula σ j P V n R (MAndAssign φ conf) (Formula.And φ' ψ')"
  | AndRel: "wf_mformula σ j P V n R φ φ' 
    ψ' = formula_of_constraint conf 
    (let (t1, _, _, t2) = conf in Formula.fv_trm t1  Formula.fv_trm t2  Formula.fv φ') 
    wf_mformula σ j P V n R (MAndRel φ conf) (Formula.And φ' ψ')"
  | Ands: "list_all2 (λφ φ'. wf_mformula σ j P V n R φ φ') l (l_pos @ map remove_neg l_neg) 
    wf_mbufn (progress σ P (Formula.Ands l') j) (map (λψ. progress σ P ψ j) (l_pos @ map remove_neg l_neg)) (map (λψ i.
      qtable n (Formula.fv ψ) (mem_restr R) (λv. Formula.sat σ V (map the v) i ψ)) (l_pos @ map remove_neg l_neg)) buf 
    (l_pos, l_neg) = partition safe_formula l' 
    l_pos  [] 
    list_all safe_formula (map remove_neg l_neg) 
    A_pos = map fv l_pos 
    A_neg = map fv l_neg 
    (set A_neg)  (set A_pos) 
    wf_mformula σ j P V n R (MAnds A_pos A_neg l buf) (Formula.Ands l')"
  | Or: "wf_mformula σ j P V n R φ φ'  wf_mformula σ j P V n R ψ ψ' 
    Formula.fv φ' = Formula.fv ψ' 
    wf_mbuf2' σ P V j n R φ' ψ' buf 
    wf_mformula σ j P V n R (MOr φ ψ buf) (Formula.Or φ' ψ')"
  | Neg: "wf_mformula σ j P V n R φ φ'  Formula.fv φ' = {} 
    wf_mformula σ j P V n R (MNeg φ) (Formula.Neg φ')"
  | Exists: "wf_mformula σ j P V (Suc n) (lift_envs R) φ φ' 
    wf_mformula σ j P V n R (MExists φ) (Formula.Exists φ')"
  | Agg: "wf_mformula σ j P V (b + n) (lift_envs' b R) φ φ' 
    y < n 
    y + b  Formula.fv φ' 
    {0..<b}  Formula.fv φ' 
    Formula.fv_trm f  Formula.fv φ' 
    g0 = (Formula.fv φ'  {0..<b}) 
    wf_mformula σ j P V n R (MAgg g0 y ω b f φ) (Formula.Agg y ω b f φ')"
  | Prev: "wf_mformula σ j P V n R φ φ' 
    first  j = 0 
    list_all2 (λi. qtable n (Formula.fv φ') (mem_restr R) (λv. Formula.sat σ V (map the v) i φ'))
      [min (progress σ P φ' j) (j-1)..<progress σ P φ' j] buf 
    list_all2 (λi t. t = τ σ i) [min (progress σ P φ' j) (j-1)..<j] nts 
    wf_mformula σ j P V n R (MPrev I φ first buf nts) (Formula.Prev I φ')"
  | Next: "wf_mformula σ j P V n R φ φ' 
    first  progress σ P φ' j = 0 
    list_all2 (λi t. t = τ σ i) [progress σ P φ' j - 1..<j] nts 
    wf_mformula σ j P V n R (MNext I φ first nts) (Formula.Next I φ')"
  | Since: "wf_mformula σ j P V n R φ φ'  wf_mformula σ j P V n R ψ ψ' 
    if args_pos args then φ'' = φ' else φ'' = Formula.Neg φ' 
    safe_formula φ'' = args_pos args 
    args_ivl args = I 
    args_n args = n 
    args_L args = Formula.fv φ' 
    args_R args = Formula.fv ψ' 
    Formula.fv φ'  Formula.fv ψ' 
    wf_mbuf2' σ P V j n R φ' ψ' buf 
    wf_ts σ P j φ' ψ' nts 
    wf_since_aux σ V R args φ' ψ' aux (progress σ P (Formula.Since φ'' I ψ') j) 
    wf_mformula σ j P V n R (MSince args φ ψ buf nts aux) (Formula.Since φ'' I ψ')"
  | Until: "wf_mformula σ j P V n R φ φ'  wf_mformula σ j P V n R ψ ψ' 
    if args_pos args then φ'' = φ' else φ'' = Formula.Neg φ' 
    safe_formula φ'' = args_pos args 
    args_ivl args = I 
    args_n args = n 
    args_L args = Formula.fv φ' 
    args_R args = Formula.fv ψ' 
    Formula.fv φ'  Formula.fv ψ' 
    wf_mbuf2' σ P V j n R φ' ψ' buf 
    wf_ts σ P j φ' ψ' nts 
    wf_until_aux σ V R args φ' ψ' aux (progress σ P (Formula.Until φ'' I ψ') j) 
    progress σ P (Formula.Until φ'' I ψ') j + length_muaux args aux = min (progress σ P φ' j) (progress σ P ψ' j) 
    wf_mformula σ j P V n R (MUntil args φ ψ buf nts aux) (Formula.Until φ'' I ψ')"
  | MatchP: "(case to_mregex r of (mr', φs') 
      list_all2 (wf_mformula σ j P V n R) φs φs'  mr = mr') 
    mrs = sorted_list_of_set (RPDs mr) 
    safe_regex Past Strict r 
    wf_mbufn' σ P V j n R r buf 
    wf_ts_regex σ P j r nts 
    wf_matchP_aux σ V n R I r aux (progress σ P (Formula.MatchP I r) j) 
    wf_mformula σ j P V n R (MMatchP I mr mrs φs buf nts aux) (Formula.MatchP I r)"
  | MatchF: "(case to_mregex r of (mr', φs') 
      list_all2 (wf_mformula σ j P V n R) φs φs'  mr = mr') 
    mrs = sorted_list_of_set (LPDs mr) 
    safe_regex Futu Strict r 
    wf_mbufn' σ P V j n R r buf 
    wf_ts_regex σ P j r nts 
    wf_matchF_aux σ V n R I r aux (progress σ P (Formula.MatchF I r) j) 0 
    progress σ P (Formula.MatchF I r) j + length aux = progress_regex σ P r j 
    wf_mformula σ j P V n R (MMatchF I mr mrs φs buf nts aux) (Formula.MatchF I r)"

definition (in maux) wf_mstate :: "Formula.formula  Formula.prefix  event_data list set  ('msaux, 'muaux) mstate  bool" where
  "wf_mstate φ π R st  mstate_n st = Formula.nfv φ  (σ. prefix_of π σ 
    mstate_i st = progress σ Map.empty φ (plen π) 
    wf_mformula σ (plen π) Map.empty Map.empty (mstate_n st) R (mstate_m st) φ)"


subsubsection ‹Initialisation›


lemma wf_mbuf2'_0: "pred_mapping (λx. x = 0) P  wf_mbuf2' σ P V 0 n R φ ψ ([], [])"
  unfolding wf_mbuf2'_def wf_mbuf2_def by simp

lemma wf_mbufn'_0: "to_mregex r = (mr, φs)  pred_mapping (λx. x = 0) P  wf_mbufn' σ P V 0 n R r (replicate (length φs) [])"
  unfolding wf_mbufn'_def wf_mbufn_def map_replicate_const[symmetric]
  by (auto simp: list_all3_map intro: list_all3_refl simp: Min_eq_iff progress_regex_def)

lemma wf_ts_0: "wf_ts σ P 0 φ ψ []"
  unfolding wf_ts_def by simp

lemma wf_ts_regex_0: "wf_ts_regex σ P 0 r []"
  unfolding wf_ts_regex_def by simp

lemma (in msaux) wf_since_aux_Nil: "Formula.fv φ'  Formula.fv ψ' 
  wf_since_aux σ V R (init_args I n (Formula.fv φ') (Formula.fv ψ') b) φ' ψ' (init_msaux (init_args I n (Formula.fv φ') (Formula.fv ψ') b)) 0"
  unfolding wf_since_aux_def by (auto intro!: valid_init_msaux)

lemma (in muaux) wf_until_aux_Nil: "Formula.fv φ'  Formula.fv ψ' 
  wf_until_aux σ V R (init_args I n (Formula.fv φ') (Formula.fv ψ') b) φ' ψ' (init_muaux (init_args I n (Formula.fv φ') (Formula.fv ψ') b)) 0"
  unfolding wf_until_aux_def wf_until_auxlist_def by (auto intro: valid_init_muaux)

lemma wf_matchP_aux_Nil: "wf_matchP_aux σ V n R I r [] 0"
  unfolding wf_matchP_aux_def by simp

lemma wf_matchF_aux_Nil: "wf_matchF_aux σ V n R I r [] 0 k"
  unfolding wf_matchF_aux_def by simp

lemma fv_regex_alt: "safe_regex m g r  Formula.fv_regex r = (φ  atms r. Formula.fv φ)"
  unfolding fv_regex_alt atms_def
  by (auto 0 3 dest: safe_regex_safe_formula)

lemmas to_mregex_atms =
  to_mregex_ok[THEN conjunct1, THEN equalityD1, THEN set_mp, rotated]

lemma (in maux) wf_minit0: "safe_formula φ  xFormula.fv φ. x < n 
  pred_mapping (λx. x = 0) P 
  wf_mformula σ 0 P V n R (minit0 n φ) φ"
proof (induction arbitrary: n R P V rule: safe_formula_induct)
  case (Eq_Const c d)
  then show ?case
    by (auto simp add: is_simple_eq_def simp del: eq_rel.simps intro!: wf_mformula.Eq)
next
  case (Eq_Var1 c x)
  then show ?case
    by (auto simp add: is_simple_eq_def simp del: eq_rel.simps intro!: wf_mformula.Eq)
next
  case (Eq_Var2 c x)
  then show ?case
    by (auto simp add: is_simple_eq_def simp del: eq_rel.simps intro!: wf_mformula.Eq)
next
  case (neq_Var x y)
  then show ?case by (auto intro!: wf_mformula.neq_Var)
next
  case (Pred e ts)
  then show ?case by (auto intro!: wf_mformula.Pred)
next
  case (Let p φ ψ)
  with fvi_less_nfv show ?case
    by (auto simp: pred_mapping_alt dom_def intro!: wf_mformula.Let Let(4,5))
next
  case (And_assign φ ψ)
  then have 1: "xfv ψ. x < n" by simp
  from 1 ‹safe_assignment (fv φ) ψ
  obtain x t where
    "x < n" "x  fv φ" "fv_trm t  fv φ"
    "ψ = Formula.Eq (Formula.Var x) t  ψ = Formula.Eq t (Formula.Var x)"
    unfolding safe_assignment_def by (force split: formula.splits trm.splits)
  with And_assign show ?case
    by (auto intro!: wf_mformula.AndAssign split: trm.splits)
next
  case (And_safe φ ψ)
  then show ?case by (auto intro!: wf_mformula.And wf_mbuf2'_0)
next
  case (And_constraint φ ψ)
  from ‹fv ψ  fv φ ‹is_constraint ψ
  obtain t1 p c t2 where
    "(t1, p, c, t2) = split_constraint ψ"
    "formula_of_constraint (split_constraint ψ) = ψ"
    "fv_trm t1  fv_trm t2  fv φ"
    by (induction rule: is_constraint.induct) auto
  with And_constraint show ?case
    by (auto 0 3 intro!: wf_mformula.AndRel)
next
  case (And_Not φ ψ)
  then show ?case by (auto intro!: wf_mformula.And wf_mbuf2'_0)
next
  case (Ands l pos neg)
  note posneg = "Ands.hyps"(1)
  let ?wf_minit = "λx. wf_mformula σ 0 P V n R (minit0 n x)"
  let ?pos = "filter safe_formula l"
  let ?neg = "filter (Not  safe_formula) l"
  have "list_all2 ?wf_minit ?pos pos"
    using Ands.IH(1) Ands.prems posneg by (auto simp: list_all_iff intro!: list.rel_refl_strong)
  moreover have "list_all2 ?wf_minit (map remove_neg ?neg) (map remove_neg neg)"
    using Ands.IH(2) Ands.prems posneg by (auto simp: list.rel_map list_all_iff intro!: list.rel_refl_strong)
  moreover have "list_all3 (λ_ _ _. True) (?pos @ map remove_neg ?neg) (?pos @ map remove_neg ?neg) l"
    by (auto simp: list_all3_conv_all_nth comp_def sum_length_filter_compl)
  moreover have "l  []  (MIN φset l. (0 :: nat)) = 0"
    by (cases l) (auto simp: Min_eq_iff)
  ultimately show ?case using Ands.hyps Ands.prems(2)
    by (auto simp: wf_mbufn_def list_all3_map list.rel_map map_replicate_const[symmetric] subset_eq
        map_map[symmetric] map_append[symmetric] simp del: map_map map_append
        intro!: wf_mformula.Ands list_all2_appendI)
next
  case (Neg φ)
  then show ?case by (auto intro!: wf_mformula.Neg)
next
  case (Or φ ψ)
  then show ?case by (auto intro!: wf_mformula.Or wf_mbuf2'_0)
next
  case (Exists φ)
  then show ?case by (auto simp: fvi_Suc_bound intro!: wf_mformula.Exists)
next
  case (Agg y ω b f φ)
  then show ?case by (auto intro!: wf_mformula.Agg Agg.IH fvi_plus_bound)
next
  case (Prev I φ)
  thm wf_mformula.Prev[where P=P]
  then show ?case by (auto intro!: wf_mformula.Prev)
next
  case (Next I φ)
  then show ?case by (auto intro!: wf_mformula.Next)
next
  case (Since φ I ψ)
  then show ?case
    using wf_since_aux_Nil
    by (auto simp add: init_args_def intro!: wf_mformula.Since wf_mbuf2'_0 wf_ts_0)
next
  case (Not_Since φ I ψ)
  then show ?case
    using wf_since_aux_Nil
    by (auto simp add: init_args_def intro!: wf_mformula.Since wf_mbuf2'_0 wf_ts_0)
next
  case (Until φ I ψ)
  then show ?case
    using valid_length_muaux[OF valid_init_muaux[OF Until(1)]] wf_until_aux_Nil
    by (auto simp add: init_args_def simp del: progress_simps intro!: wf_mformula.Until wf_mbuf2'_0 wf_ts_0)
next
  case (Not_Until φ I ψ)
  then show ?case
    using valid_length_muaux[OF valid_init_muaux[OF Not_Until(1)]] wf_until_aux_Nil
    by (auto simp add: init_args_def simp del: progress_simps intro!: wf_mformula.Until wf_mbuf2'_0 wf_ts_0)
next
  case (MatchP I r)
  then show ?case
    by (auto simp: list.rel_map fv_regex_alt simp del: progress_simps split: prod.split
        intro!: wf_mformula.MatchP list.rel_refl_strong wf_mbufn'_0 wf_ts_regex_0 wf_matchP_aux_Nil
        dest!: to_mregex_atms)
next
  case (MatchF I r)
  then show ?case
    by (auto simp: list.rel_map fv_regex_alt progress_le Min_eq_iff progress_regex_def
        simp del: progress_simps split: prod.split
        intro!: wf_mformula.MatchF list.rel_refl_strong wf_mbufn'_0 wf_ts_regex_0 wf_matchF_aux_Nil
        dest!: to_mregex_atms)
qed

lemma (in maux) wf_mstate_minit: "safe_formula φ  wf_mstate φ pnil R (minit φ)"
  unfolding wf_mstate_def minit_def Let_def
  by (auto intro!: wf_minit0 fvi_less_nfv)


subsubsection ‹Evaluation›

lemma match_wf_tuple: "Some f = match ts xs 
  wf_tuple n (tset ts. Formula.fv_trm t) (Table.tabulate f 0 n)"
  by (induction ts xs arbitrary: f rule: match.induct)
    (fastforce simp: wf_tuple_def split: if_splits option.splits)+

lemma match_fvi_trm_None: "Some f = match ts xs  tset ts. x  Formula.fv_trm t  f x = None"
  by (induction ts xs arbitrary: f rule: match.induct) (auto split: if_splits option.splits)

lemma match_fvi_trm_Some: "Some f = match ts xs  t  set ts  x  Formula.fv_trm t  f x  None"
  by (induction ts xs arbitrary: f rule: match.induct) (auto split: if_splits option.splits)

lemma match_eval_trm: "tset ts. iFormula.fv_trm t. i < n  Some f = match ts xs 
    map (Formula.eval_trm (Table.tabulate (λi. the (f i)) 0 n)) ts = xs"
proof (induction ts xs arbitrary: f rule: match.induct)
  case (3 x ts y ys)
  from 3(1)[symmetric] 3(2,3) show ?case
    by (auto 0 3 dest: match_fvi_trm_Some sym split: option.splits if_splits intro!: eval_trm_fv_cong)
qed (auto split: if_splits)

lemma wf_tuple_tabulate_Some: "wf_tuple n A (Table.tabulate f 0 n)  x  A  x < n  y. f x = Some y"
  unfolding wf_tuple_def by auto

lemma ex_match: "wf_tuple n (tset ts. Formula.fv_trm t) v 
  tset ts. (xFormula.fv_trm t. x < n)  (Formula.is_Var t  Formula.is_Const t) 
  f. match ts (map (Formula.eval_trm (map the v)) ts) = Some f  v = Table.tabulate f 0 n"
proof (induction ts "map (Formula.eval_trm (map the v)) ts" arbitrary: v rule: match.induct)
  case (3 x ts y ys)
  then show ?case
  proof (cases "x  (tset ts. Formula.fv_trm t)")
    case True
    with 3 show ?thesis
      by (auto simp: insert_absorb dest!: wf_tuple_tabulate_Some meta_spec[of _ v])
  next
    case False
    with 3(3,4) have
      *: "map (Formula.eval_trm (map the v)) ts = map (Formula.eval_trm (map the (v[x := None]))) ts"
      by (auto simp: wf_tuple_def nth_list_update intro!: eval_trm_fv_cong)
    from False 3(2-4) obtain f where
      "match ts (map (Formula.eval_trm (map the v)) ts) = Some f" "v[x := None] = Table.tabulate f 0 n"
      unfolding *
      by (atomize_elim, intro 3(1)[of "v[x := None]"])
        (auto simp: wf_tuple_def nth_list_update intro!: eval_trm_fv_cong)
    moreover from False this have "f x = None" "length v = n"
      by (auto dest: match_fvi_trm_None[OF sym] arg_cong[of _ _ length])
    ultimately show ?thesis using 3(3)
      by (auto simp: list_eq_iff_nth_eq wf_tuple_def)
  qed
qed (auto simp: wf_tuple_def intro: nth_equalityI)

lemma eq_rel_eval_trm: "v  eq_rel n t1 t2  is_simple_eq t1 t2 
  xFormula.fv_trm t1  Formula.fv_trm t2. x < n 
  Formula.eval_trm (map the v) t1 = Formula.eval_trm (map the v) t2"
  by (cases t1; cases t2) (simp_all add: is_simple_eq_def singleton_table_def split: if_splits)

lemma in_eq_rel: "wf_tuple n (Formula.fv_trm t1  Formula.fv_trm t2) v 
  is_simple_eq t1 t2 
  Formula.eval_trm (map the v) t1 = Formula.eval_trm (map the v) t2 
  v  eq_rel n t1 t2"
  by (cases t1; cases t2)
    (auto simp: is_simple_eq_def singleton_table_def wf_tuple_def unit_table_def
      intro!: nth_equalityI split: if_splits)

lemma table_eq_rel: "is_simple_eq t1 t2 
  table n (Formula.fv_trm t1  Formula.fv_trm t2) (eq_rel n t1 t2)"
  by (cases t1; cases t2; simp add: is_simple_eq_def)

lemma wf_tuple_Suc_fviD: "wf_tuple (Suc n) (Formula.fvi b φ) v  wf_tuple n (Formula.fvi (Suc b) φ) (tl v)"
  unfolding wf_tuple_def by (simp add: fvi_Suc nth_tl)

lemma table_fvi_tl: "table (Suc n) (Formula.fvi b φ) X  table n (Formula.fvi (Suc b) φ) (tl ` X)"
  unfolding table_def by (auto intro: wf_tuple_Suc_fviD)

lemma wf_tuple_Suc_fvi_SomeI: "0  Formula.fvi b φ  wf_tuple n (Formula.fvi (Suc b) φ) v 
  wf_tuple (Suc n) (Formula.fvi b φ) (Some x # v)"
  unfolding wf_tuple_def
  by (auto simp: fvi_Suc less_Suc_eq_0_disj)

lemma wf_tuple_Suc_fvi_NoneI: "0  Formula.fvi b φ  wf_tuple n (Formula.fvi (Suc b) φ) v 
  wf_tuple (Suc n) (Formula.fvi b φ) (None # v)"
  unfolding wf_tuple_def
  by (auto simp: fvi_Suc less_Suc_eq_0_disj)

lemma qtable_project_fv: "qtable (Suc n) (fv φ) (mem_restr (lift_envs R)) P X 
    qtable n (Formula.fvi (Suc 0) φ) (mem_restr R)
      (λv. x. P ((if 0  fv φ then Some x else None) # v)) (tl ` X)"
  using neq0_conv by (fastforce simp: image_iff Bex_def fvi_Suc elim!: qtable_cong dest!: qtable_project)

lemma mem_restr_lift_envs'_append[simp]:
  "length xs = b  mem_restr (lift_envs' b R) (xs @ ys) = mem_restr R ys"
  unfolding mem_restr_def lift_envs'_def
  by (auto simp: list_all2_append list.rel_map intro!: exI[where x="map the xs"] list.rel_refl)

lemma nth_list_update_alt: "xs[i := x] ! j = (if i < length xs  i = j then x else xs ! j)"
  by auto

lemma wf_tuple_upd_None: "wf_tuple n A xs  A - {i} = B  wf_tuple n B (xs[i:=None])"
  unfolding wf_tuple_def
  by (auto simp: nth_list_update_alt)

lemma mem_restr_upd_None: "mem_restr R xs  mem_restr R (xs[i:=None])"
  unfolding mem_restr_def
  by (auto simp: list_all2_conv_all_nth nth_list_update_alt)

lemma mem_restr_dropI: "mem_restr (lift_envs' b R) xs  mem_restr R (drop b xs)"
  unfolding mem_restr_def lift_envs'_def
  by (auto simp: append_eq_conv_conj list_all2_append2)

lemma mem_restr_dropD:
  assumes "b  length xs" and "mem_restr R (drop b xs)"
  shows "mem_restr (lift_envs' b R) xs"
proof -
  let ?R = "λa b. a  None  a = Some b"
  from assms(2) obtain v where "v  R" and "list_all2 ?R (drop b xs) v"
    unfolding mem_restr_def ..
  show ?thesis unfolding mem_restr_def proof
    have "list_all2 ?R (take b xs) (map the (take b xs))"
      by (auto simp: list.rel_map intro!: list.rel_refl)
    moreover note ‹list_all2 ?R (drop b xs) v
    ultimately have "list_all2 ?R (take b xs @ drop b xs) (map the (take b xs) @ v)"
      by (rule list_all2_appendI)
    then show "list_all2 ?R xs (map the (take b xs) @ v)" by simp
    show "map the (take b xs) @ v  lift_envs' b R"
      unfolding lift_envs'_def using assms(1) v  R by auto
  qed
qed

lemma wf_tuple_append: "wf_tuple a {x  A. x < a} xs 
  wf_tuple b {x - a | x. x  A  x  a} ys 
  wf_tuple (a + b) A (xs @ ys)"
  unfolding wf_tuple_def by (auto simp: nth_append eq_diff_iff)

lemma wf_tuple_map_Some: "length xs = n  {0..<n}  A  wf_tuple n A (map Some xs)"
  unfolding wf_tuple_def by auto

lemma wf_tuple_drop: "wf_tuple (b + n) A xs  {x - b | x. x  A  x  b} = B 
  wf_tuple n B (drop b xs)"
  unfolding wf_tuple_def by force

lemma ecard_image: "inj_on f A  ecard (f ` A) = ecard A"
  unfolding ecard_def by (auto simp: card_image dest: finite_imageD)

lemma meval_trm_eval_trm: "wf_tuple n A x  fv_trm t  A  iA. i < n 
    meval_trm t x = Formula.eval_trm (map the x) t"
  unfolding wf_tuple_def
  by (induction t) simp_all

lemma list_update_id: "xs ! i = z  xs[i:=z] = xs"
  by (induction xs arbitrary: i) (auto split: nat.split)

lemma qtable_wf_tupleD: "qtable n A P Q X  xX. wf_tuple n A x"
  unfolding qtable_def table_def by blast

lemma qtable_eval_agg:
  assumes inner: "qtable (b + n) (Formula.fv φ) (mem_restr (lift_envs' b R))
      (λv. Formula.sat σ V (map the v) i φ) rel"
    and n: "xFormula.fv (Formula.Agg y ω b f φ). x < n"
    and fresh: "y + b  Formula.fv φ"
    and b_fv: "{0..<b}  Formula.fv φ"
    and f_fv: "Formula.fv_trm f  Formula.fv φ"
    and g0: "g0 = (Formula.fv φ  {0..<b})"
  shows "qtable n (Formula.fv (Formula.Agg y ω b f φ)) (mem_restr R)
      (λv. Formula.sat σ V (map the v) i (Formula.Agg y ω b f φ)) (eval_agg n g0 y ω b f rel)"
    (is "qtable _ ?fv _ ?Q ?rel'")
proof -
  define M where "M = (λv. {(x, ecard Zs) | x Zs.
      Zs = {zs. length zs = b  Formula.sat σ V (zs @ v) i φ  Formula.eval_trm (zs @ v) f = x} 
      Zs  {}})"
  have f_fvi: "Formula.fvi_trm b f  Formula.fvi b φ"
    using f_fv by (auto simp: fvi_trm_iff_fv_trm[where b=b] fvi_iff_fv[where b=b])
  show ?thesis proof (cases "g0  rel = empty_table")
    case True
    then have [simp]: "Formula.fvi b φ = {}"
      by (auto simp: g0 fvi_iff_fv(1)[where b=b])
    then have [simp]: "Formula.fvi_trm b f = {}"
      using f_fvi by auto
    show ?thesis proof (rule qtableI)
      show "table n ?fv ?rel'" by (simp add: eval_agg_def True)
    next
      fix v
      assume "wf_tuple n ?fv v" "mem_restr R v"
      have "¬ Formula.sat σ V (zs @ map the v) i φ" if [simp]: "length zs = b" for zs
      proof -
        let ?zs = "map2 (λz i. if i  Formula.fv φ then Some z else None) zs [0..<b]"
        have "wf_tuple b {x  fv φ. x < b} ?zs"
          by (simp add: wf_tuple_def)
        then have "wf_tuple (b + n) (Formula.fv φ) (?zs @ v[y:=None])"
          using ‹wf_tuple n ?fv v True
          by (auto simp: g0 intro!: wf_tuple_append wf_tuple_upd_None)
        then have "¬ Formula.sat σ V (map the (?zs @ v[y:=None])) i φ"
          using True ‹mem_restr R v
          by (auto simp del: map_append dest!: in_qtableI[OF inner, rotated -1]
              intro!: mem_restr_upd_None)
        also have "Formula.sat σ V (map the (?zs @ v[y:=None])) i φ  Formula.sat σ V (zs @ map the v) i φ"
          using True by (auto simp: g0 nth_append intro!: sat_fv_cong)
        finally show ?thesis .
      qed
      then have M_empty: "M (map the v) = {}"
        unfolding M_def by blast
      show "Formula.sat σ V (map the v) i (Formula.Agg y ω b f φ)"
        if "v  eval_agg n g0 y ω b f rel"
        using M_empty True that n
        by (simp add: M_def eval_agg_def g0 singleton_table_def)
      have "v  singleton_table n y (the (v ! y))" "length v = n"
        using ‹wf_tuple n ?fv v unfolding wf_tuple_def singleton_table_def
        by (auto simp add: tabulate_alt map_nth
            intro!: trans[OF map_cong[where g="(!) v", simplified nth_map, OF refl], symmetric])
      then show "v  eval_agg n g0 y ω b f rel"
        if "Formula.sat σ V (map the v) i (Formula.Agg y ω b f φ)"
        using M_empty True that n
        by (simp add: M_def eval_agg_def g0)
    qed
  next
    case non_default_case: False
    have union_fv: "{0..<b}  (λx. x + b) ` Formula.fvi b φ = fv φ"
      using b_fv
      by (auto simp: fvi_iff_fv(1)[where b=b] intro!: image_eqI[where b=x and x="x - b" for x])
    have b_n: "xfv φ. x < b + n"
    proof
      fix x assume "x  fv φ"
      show "x < b + n" proof (cases "x  b")
        case True
        with x  fv φ have "x - b  ?fv"
          by (simp add: fvi_iff_fv(1)[where b=b])
        then show ?thesis using n f_fvi by (auto simp: Un_absorb2)
      qed simp
    qed

    define M' where "M' = (λk. let group = Set.filter (λx. drop b x = k) rel;
        images = meval_trm f ` group
      in (λy. (y, ecard (Set.filter (λx. meval_trm f x = y) group))) ` images)"
    have M'_M: "M' (drop b x) = M (map the (drop b x))" if "x  rel" "mem_restr (lift_envs' b R) x" for x
    proof -
      from that have wf_x: "wf_tuple (b + n) (fv φ) x"
        by (auto elim!: in_qtableE[OF inner])
      then have wf_zs_x: "wf_tuple (b + n) (fv φ) (map Some zs @ drop b x)"
        if "length zs = b" for zs
        using that b_fv
        by (auto intro!: wf_tuple_append wf_tuple_map_Some wf_tuple_drop)
      have 1: "(length zs = b  Formula.sat σ V (zs @ map the (drop b x)) i φ 
          Formula.eval_trm (zs @ map the (drop b x)) f = y) 
        (a. a  rel  take b a = map Some zs  drop b a = drop b x  meval_trm f a = y)"
        (is "?A  (a. ?B a)") for y zs
      proof (intro iffI conjI)
        assume ?A
        then have "?B (map Some zs @ drop (length zs) x)"
          using in_qtableI[OF inner wf_zs_x] ‹mem_restr (lift_envs' b R) x
            meval_trm_eval_trm[OF wf_zs_x f_fv b_n]
          by (auto intro!: mem_restr_dropI)
        then show "a. ?B a" ..
      next
        assume "a. ?B a"
        then obtain a where "?B a" ..
        then have "a  rel" and a_eq: "a = map Some zs @ drop b x"
          using append_take_drop_id[of b a] by auto
        then have "length a = b + n"
          using inner unfolding qtable_def table_def
          by (blast intro!: wf_tuple_length)
        then show "length zs = b"
          using wf_tuple_length[OF wf_x] unfolding a_eq by simp
        then have "mem_restr (lift_envs' b R) a"
          using ‹mem_restr _ x unfolding a_eq by (auto intro!: mem_restr_dropI)
        then show "Formula.sat σ V (zs @ map the (drop b x)) i φ"
          using in_qtableE[OF inner a  rel]
          by (auto simp: a_eq sat_fv_cong[THEN iffD1, rotated -1])
        from ?B a show "Formula.eval_trm (zs @ map the (drop b x)) f = y"
          using meval_trm_eval_trm[OF wf_zs_x f_fv b_n, OF ‹length zs = b]
          unfolding a_eq by simp
      qed
      have 2: "map Some (map the (take b a)) = take b a" if "a  rel" for a
        using that b_fv inner[THEN qtable_wf_tupleD]
        unfolding table_def wf_tuple_def
        by (auto simp: list_eq_iff_nth_eq)
      have 3: "ecard {zs. a. a  rel  take b a = map Some zs  drop b a = drop b x  P a} =
        ecard {a. a  rel  drop b a = drop b x  P a}" (is "ecard ?A = ecard ?B") for P
      proof -
        have "ecard ?A = ecard ((λzs. map Some zs @ drop b x) ` ?A)"
          by (auto intro!: ecard_image[symmetric] inj_onI)
        also have "(λzs. map Some zs @ drop b x) ` ?A = ?B"
          by (subst (1 2) eq_commute) (auto simp: image_iff, metis "2" append_take_drop_id)
        finally show ?thesis .
      qed
      show ?thesis
        unfolding M_def M'_def
        by (auto simp: non_default_case Let_def image_def Set.filter_def 1 3, metis "2")
    qed
    have drop_lift: "mem_restr (lift_envs' b R) x" if "x  rel" "mem_restr R ((drop b x)[y:=z])" for x z
    proof -
      have "(drop b x)[y:=None] = (drop b x)[y:=drop b x ! y]" proof -
        from x  rel have "drop b x ! y = None"
          using fresh n inner[THEN qtable_wf_tupleD]
          by (simp add: add.commute wf_tuple_def)
        then show ?thesis by simp
      qed
      then have "(drop b x)[y:=None] = drop b x" by simp
      moreover from x  rel have "length x = b + n"
        using inner[THEN qtable_wf_tupleD]
        by (simp add: wf_tuple_def)
      moreover from that(2) have "mem_restr R ((drop b x)[y:=z, y:=None])"
        by (rule mem_restr_upd_None)
      ultimately show ?thesis
        by (auto intro!: mem_restr_dropD)
    qed

    {
      fix v
      assume "mem_restr R v"
      have "v  (λk. k[y:=Some (eval_agg_op ω (M' k))]) ` drop b ` rel 
          v  (λk. k[y:=Some (eval_agg_op ω (M (map the k)))]) ` drop b ` rel"
        (is "v  ?A  v  ?B")
      proof
        assume "v  ?A"
        then obtain v' where *: "v'  rel" "v = (drop b v')[y:=Some (eval_agg_op ω (M' (drop b v')))]"
          by auto
        then have "M' (drop b v') = M (map the (drop b v'))"
          using ‹mem_restr R v by (auto intro!: M'_M drop_lift)
        with * show "v  ?B" by simp
      next
        assume "v  ?B"
        then obtain v' where *: "v'  rel" "v = (drop b v')[y:=Some (eval_agg_op ω (M (map the (drop b v'))))]"
          by auto
        then have "M (map the (drop b v')) = M' (drop b v')"
          using ‹mem_restr R v by (auto intro!: M'_M[symmetric] drop_lift)
        with * show "v  ?A" by simp
      qed
      then have "v  eval_agg n g0 y ω b f rel  v  (λk. k[y:=Some (eval_agg_op ω (M (map the k)))]) ` drop b ` rel"
        by (simp add: non_default_case eval_agg_def M'_def Let_def)
    }
    note alt = this

    show ?thesis proof (rule qtableI)
      show "table n ?fv ?rel'"
        using inner[THEN qtable_wf_tupleD] n f_fvi
        by (auto simp: eval_agg_def non_default_case table_def wf_tuple_def Let_def nth_list_update
            fvi_iff_fv[where b=b] add.commute)
    next
      fix v
      assume "wf_tuple n ?fv v" "mem_restr R v"
      then have length_v: "length v = n" by (simp add: wf_tuple_def)

      show "Formula.sat σ V (map the v) i (Formula.Agg y ω b f φ)"
        if "v  eval_agg n g0 y ω b f rel"
      proof -
        from that obtain v' where "v'  rel"
          "v = (drop b v')[y:=Some (eval_agg_op ω (M (map the (drop b v'))))]"
          using alt[OF ‹mem_restr R v] by blast
        then have length_v': "length v' = b + n"
          using inner[THEN qtable_wf_tupleD]
          by (simp add: wf_tuple_def)
        have "Formula.sat σ V (map the v') i φ"
          using v'  rel ‹mem_restr R v
          by (auto simp: v = _ elim!: in_qtableE[OF inner] intro!: drop_lift v'  rel)
        then have "Formula.sat σ V (map the (take b v') @ map the v) i φ"
        proof (rule sat_fv_cong[THEN iffD1, rotated], intro ballI)
          fix x
          assume "x  fv φ"
          then have "x  y + b" using fresh by blast
          moreover have "x < length v'"
            using x  fv φ b_n by (simp add: length_v')
          ultimately show "map the v' ! x = (map the (take b v') @ map the v) ! x"
            by (auto simp: v = _ nth_append)
        qed
        then have 1: "M (map the v)  {}" by (force simp: M_def length_v')

        have "y < length (drop b v')" using n by (simp add: length_v')
        moreover have "Formula.sat σ V (zs @ map the v) i φ 
          Formula.sat σ V (zs @ map the (drop b v')) i φ" if "length zs = b" for zs
        proof (intro sat_fv_cong ballI)
          fix x
          assume "x  fv φ"
          then have "x  y + b" using fresh by blast
          moreover have "x < length v'"
            using x  fv φ b_n by (simp add: length_v')
          ultimately show "(zs @ map the v) ! x = (zs @ map the (drop b v')) ! x"
            by (auto simp: v = _ that nth_append)
        qed
        moreover have "Formula.eval_trm (zs @ map the v) f =
          Formula.eval_trm (zs @ map the (drop b v')) f" if "length zs = b" for zs
        proof (intro eval_trm_fv_cong ballI)
          fix x
          assume "x  fv_trm f"
          then have "x  y + b" using f_fv fresh by blast
          moreover have "x < length v'"
            using x  fv_trm f f_fv b_n by (auto simp: length_v')
          ultimately show "(zs @ map the v) ! x = (zs @ map the (drop b v')) ! x"
            by (auto simp: v = _ that nth_append)
        qed
        ultimately have "map the v ! y = eval_agg_op ω (M (map the v))"
          by (simp add: M_def v = _ conj_commute cong: conj_cong)
        with 1 show ?thesis by (auto simp: M_def)
      qed

      show "v  eval_agg n g0 y ω b f rel"
        if sat_Agg: "Formula.sat σ V (map the v) i (Formula.Agg y ω b f φ)"
      proof -
        obtain zs where "length zs = b" and "map Some zs @ v[y:=None]  rel"
        proof (cases "fv φ  {0..<b}")
          case True
          with non_default_case have "rel  empty_table" by (simp add: g0)
          then obtain x where "x  rel" by auto
          have "(i < n. (v[y:=None]) ! i = None)"
            using True ‹wf_tuple n ?fv v f_fv
            by (fastforce simp: wf_tuple_def fvi_iff_fv[where b=b] fvi_trm_iff_fv_trm[where b=b])
          moreover have x: "(i < n. drop b x ! i = None)  length x = b + n"
            using True x  rel inner[THEN qtable_wf_tupleD] f_fv
            by (auto simp: wf_tuple_def)
          ultimately have "v[y:=None] = drop b x"
            unfolding list_eq_iff_nth_eq by (auto simp: length_v)
          with x  rel have "take b x @ v[y:=None]  rel" by simp
          moreover have "map (Some  the) (take b x) = take b x"
            using True x  rel inner[THEN qtable_wf_tupleD] b_fv
            by (subst map_cong[where g=id, OF refl]) (auto simp: wf_tuple_def in_set_conv_nth)
          ultimately have "map Some (map the (take b x)) @ v[y:=None]  rel" by simp
          then show thesis using x[THEN conjunct2] by (fastforce intro!: that[rotated])
        next
          case False
          with sat_Agg obtain zs where "length zs = b" and "Formula.sat σ V (zs @ map the v) i φ"
            by auto
          then have "Formula.sat σ V (zs @ map the (v[y:=None])) i φ"
            using fresh
            by (auto simp: map_update not_less nth_append elim!: sat_fv_cong[THEN iffD1, rotated]
                intro!: nth_list_update_neq[symmetric])
          then have "map Some zs @ v[y:=None]  rel"
            using b_fv f_fv fresh
            by (auto intro!: in_qtableI[OF inner] wf_tuple_append wf_tuple_map_Some
                wf_tuple_upd_None ‹wf_tuple n ?fv v mem_restr_upd_None ‹mem_restr R v
                simp: ‹length zs = b set_eq_iff fvi_iff_fv[where b=b] fvi_trm_iff_fv_trm[where b=b])
              force+
          with that ‹length zs = b show thesis by blast
        qed
        then have 1: "v[y:=None]  drop b ` rel" by (intro image_eqI) auto

        have y_length: "y < length v" using n by (simp add: length_v)
        moreover have "Formula.sat σ V (zs @ map the (v[y:=None])) i φ 
          Formula.sat σ V (zs @ map the v) i φ" if "length zs = b" for zs
        proof (intro sat_fv_cong ballI)
          fix x
          assume "x  fv φ"
          then have "x  y + b" using fresh by blast
          moreover have "x < b + length v"
            using x  fv φ b_n by (simp add: length_v)
          ultimately show "(zs @ map the (v[y:=None])) ! x = (zs @ map the v) ! x"
            by (auto simp: that nth_append)
        qed
        moreover have "Formula.eval_trm (zs @ map the (v[y:=None])) f =
          Formula.eval_trm (zs @ map the v) f" if "length zs = b" for zs
        proof (intro eval_trm_fv_cong ballI)
          fix x
          assume "x  fv_trm f"
          then have "x  y + b" using f_fv fresh by blast
          moreover have "x < b + length v"
            using x  fv_trm f f_fv b_n by (auto simp: length_v)
          ultimately show "(zs @ map the (v[y:=None])) ! x = (zs @ map the v) ! x"
            by (auto simp: that nth_append)
        qed
        ultimately have "map the v ! y = eval_agg_op ω (M (map the (v[y:=None])))"
          using sat_Agg by (simp add: M_def cong: conj_cong) (simp cong: rev_conj_cong)
        then have 2: "v ! y = Some (eval_agg_op ω (M (map the (v[y:=None]))))"
          using ‹wf_tuple n ?fv v y_length by (auto simp add: wf_tuple_def)
        show ?thesis
          unfolding alt[OF ‹mem_restr R v]
          by (rule image_eqI[where x="v[y:=None]"]) (use 1 2 in auto simp: y_length list_update_id›)
      qed
    qed
  qed
qed

lemma mprev: "mprev_next I xs ts = (ys, xs', ts') 
  list_all2 P [i..<j'] xs  list_all2 (λi t. t = τ σ i) [i..<j] ts  i  j'  i < j 
  list_all2 (λi X. if mem (τ σ (Suc i) - τ σ i) I then P i X else X = empty_table)
    [i..<min j' (j-1)] ys 
  list_all2 P [min j' (j-1)..<j'] xs' 
  list_all2 (λi t. t = τ σ i) [min j' (j-1)..<j] ts'"
proof (induction I xs ts arbitrary: i ys xs' ts' rule: mprev_next.induct)
  case (1 I ts)
  then have "min j' (j-1) = i" by auto
  with 1 show ?case by auto
next
  case (3 I v v' t)
  then have "min j' (j-1) = i" by (auto simp: list_all2_Cons2 upt_eq_Cons_conv)
  with 3 show ?case by auto
next
  case (4 I x xs t t' ts)
  from 4(1)[of "tl ys" xs' ts' "Suc i"] 4(2-6) show ?case
    by (auto simp add: list_all2_Cons2 upt_eq_Cons_conv Suc_less_eq2
        elim!: list.rel_mono_strong split: prod.splits if_splits)
qed simp

lemma mnext: "mprev_next I xs ts = (ys, xs', ts') 
  list_all2 P [Suc i..<j'] xs  list_all2 (λi t. t = τ σ i) [i..<j] ts  Suc i  j'  i < j 
  list_all2 (λi X. if mem (τ σ (Suc i) - τ σ i) I then P (Suc i) X else X = empty_table)
    [i..<min (j'-1) (j-1)] ys 
  list_all2 P [Suc (min (j'-1) (j-1))..<j'] xs' 
  list_all2 (λi t. t = τ σ i) [min (j'-1) (j-1)..<j] ts'"
proof (induction I xs ts arbitrary: i ys xs' ts' rule: mprev_next.induct)
  case (1 I ts)
  then have "min (j' - 1) (j-1) = i" by auto
  with 1 show ?case by auto
next
  case (3 I v v' t)
  then have "min (j' - 1) (j-1) = i" by (auto simp: list_all2_Cons2 upt_eq_Cons_conv)
  with 3 show ?case by auto
next
  case (4 I x xs t t' ts)
  from 4(1)[of "tl ys" xs' ts' "Suc i"] 4(2-6) show ?case
    by (auto simp add: list_all2_Cons2 upt_eq_Cons_conv Suc_less_eq2
        elim!: list.rel_mono_strong split: prod.splits if_splits) (* slow 10 sec *)
qed simp

lemma in_foldr_UnI: "x  A  A  set xs  x  foldr (∪) xs {}"
  by (induction xs) auto

lemma in_foldr_UnE: "x  foldr (∪) xs {}  (A. A  set xs  x  A  P)  P"
  by (induction xs) auto

lemma sat_the_restrict: "fv φ  A  Formula.sat σ V (map the (restrict A v)) i φ = Formula.sat σ V (map the v) i φ"
  by (rule sat_fv_cong) (auto intro!: map_the_restrict)

lemma eps_the_restrict: "fv_regex r  A  Regex.eps (Formula.sat σ V (map the (restrict A v))) i r = Regex.eps (Formula.sat σ V (map the v)) i r"
  by (rule eps_fv_cong) (auto intro!: map_the_restrict)

lemma sorted_wrt_filter[simp]: "sorted_wrt R xs  sorted_wrt R (filter P xs)"
  by (induct xs) auto

lemma concat_map_filter[simp]:
  "concat (map f (filter P xs)) = concat (map (λx. if P x then f x else []) xs)"
  by (induct xs) auto

lemma map_filter_alt:
  "map f (filter P xs) = concat (map (λx. if P x then [f x] else []) xs)"
  by (induct xs) auto

lemma (in maux) update_since:
  assumes pre: "wf_since_aux σ V R args φ ψ aux ne"
    and qtable1: "qtable n (Formula.fv φ) (mem_restr R) (λv. Formula.sat σ V (map the v) ne φ) rel1"
    and qtable2: "qtable n (Formula.fv ψ) (mem_restr R) (λv. Formula.sat σ V (map the v) ne ψ) rel2"
    and result_eq: "(rel, aux') = update_since args rel1 rel2 (τ σ ne) aux"
    and fvi_subset: "Formula.fv φ  Formula.fv ψ"
    and args_ivl: "args_ivl args = I"
    and args_n: "args_n args = n"
    and args_L: "args_L args = Formula.fv φ"
    and args_R: "args_R args = Formula.fv ψ"
    and args_pos: "args_pos args = pos"
  shows "wf_since_aux σ V R args φ ψ aux' (Suc ne)"
    and "qtable n (Formula.fv ψ) (mem_restr R) (λv. Formula.sat σ V (map the v) ne (Sincep pos φ I ψ)) rel"
proof -
  let ?wf_tuple = "λv. wf_tuple n (Formula.fv ψ) v"
  note sat.simps[simp del]
  from pre[unfolded wf_since_aux_def] obtain cur auxlist where aux: "valid_msaux args cur aux auxlist"
    "sorted_wrt (λx y. fst y < fst x) auxlist"
    "t X. (t, X)  set auxlist  ne  0  t  τ σ (ne - 1)  τ σ (ne - 1) - t  right I 
      (i. τ σ i = t) 
      qtable n (fv ψ) (mem_restr R)
        (λv. Formula.sat σ V (map the v) (ne - 1) (Sincep pos φ (point (τ σ (ne - 1) - t)) ψ)) X"
    "t. ne  0  t  τ σ (ne - 1)  τ σ (ne - 1) - t  right I  (i. τ σ i = t) 
      (X. (t, X)  set auxlist)"
    and cur_def:
    "cur = (if ne = 0 then 0 else τ σ (ne - 1))"
    unfolding args_ivl args_n args_pos by blast
  from pre[unfolded wf_since_aux_def] have fv_sub: "Formula.fv φ  Formula.fv ψ" by simp

  define aux0 where "aux0 = join_msaux args rel1 (add_new_ts_msaux args (τ σ ne) aux)"
  define auxlist0 where "auxlist0 = [(t, join rel pos rel1). (t, rel)  auxlist, τ σ ne - t  right I]"
  have tabL: "table (args_n args) (args_L args) rel1"
    using qtable1[unfolded qtable_def] unfolding args_n[symmetric] args_L[symmetric] by simp
  have cur_le: "cur  τ σ ne"
    unfolding cur_def by auto
  have valid0: "valid_msaux args (τ σ ne) aux0 auxlist0" unfolding aux0_def auxlist0_def
    using valid_join_msaux[OF valid_add_new_ts_msaux[OF aux(1)], OF cur_le tabL]
    by (auto simp: args_ivl args_pos cur_def map_filter_alt split_beta cong: map_cong)
  from aux(2) have sorted_auxlist0: "sorted_wrt (λx y. fst x > fst y) auxlist0"
    unfolding auxlist0_def
    by (induction auxlist) (auto simp add: sorted_wrt_append)
  have in_auxlist0_1: "(t, X)  set auxlist0  ne  0  t  τ σ (ne-1)  τ σ ne - t  right I 
      (i. τ σ i = t) 
      qtable n (Formula.fv ψ) (mem_restr R) (λv. (Formula.sat σ V (map the v) (ne-1) (Sincep pos φ (point (τ σ (ne-1) - t)) ψ) 
        (if pos then Formula.sat σ V (map the v) ne φ else ¬ Formula.sat σ V (map the v) ne φ))) X" for t X
    unfolding auxlist0_def using fvi_subset
    by (auto 0 1 elim!: qtable_join[OF _ qtable1] simp: sat_the_restrict dest!: aux(3))
  then have in_auxlist0_le_τ: "(t, X)  set auxlist0  t  τ σ ne" for t X
    by (meson τ_mono diff_le_self le_trans)
  have in_auxlist0_2: "ne  0  t  τ σ (ne-1)  τ σ ne - t  right I  i. τ σ i = t 
    X. (t, X)  set auxlist0" for t
  proof -
    fix t
    assume "ne  0" "t  τ σ (ne-1)" σ ne - t  right I" "i. τ σ i = t"
    then obtain X where "(t, X)  set auxlist"
      by (atomize_elim, intro aux(4))
        (auto simp: gr0_conv_Suc elim!: order_trans[rotated] intro!: diff_le_mono τ_mono)
    with ‹τ σ ne - t  right I have "(t, join X pos rel1)  set auxlist0"
      unfolding auxlist0_def by (auto elim!: bexI[rotated] intro!: exI[of _ X])
    then show "X. (t, X)  set auxlist0"
      by blast
  qed
  have auxlist0_Nil: "auxlist0 = []  ne = 0  ne  0  (t. t  τ σ (ne-1)  τ σ ne - t  right I 
        (i. τ σ i = t))"
    using in_auxlist0_2 by (auto)

  have aux'_eq: "aux' = add_new_table_msaux args rel2 aux0"
    using result_eq unfolding aux0_def update_since_def Let_def by simp
  define auxlist' where
    auxlist'_eq: "auxlist' = (case auxlist0 of
      []  [(τ σ ne, rel2)]
    | x # auxlist'  (if fst x = τ σ ne then (fst x, snd x  rel2) # auxlist' else (τ σ ne, rel2) # x # auxlist'))"
  have tabR: "table (args_n args) (args_R args) rel2"
    using qtable2[unfolded qtable_def] unfolding args_n[symmetric] args_R[symmetric] by simp
  have valid': "valid_msaux args (τ σ ne) aux' auxlist'"
    unfolding aux'_eq auxlist'_eq using valid_add_new_table_msaux[OF valid0 tabR]
    by (auto simp: not_le split: list.splits option.splits if_splits)
  have sorted_auxlist': "sorted_wrt (λx y. fst x > fst y) auxlist'"
    unfolding auxlist'_eq
    using sorted_auxlist0 in_auxlist0_le_τ by (cases auxlist0) fastforce+
  have in_auxlist'_1: "t  τ σ ne  τ σ ne - t  right I  (i. τ σ i = t) 
      qtable n (Formula.fv ψ) (mem_restr R) (λv. Formula.sat σ V (map the v) ne (Sincep pos φ (point (τ σ ne - t)) ψ)) X"
    if auxlist': "(t, X)  set auxlist'" for t X
  proof (cases auxlist0)
    case Nil
    with auxlist' show ?thesis
      unfolding auxlist'_eq using qtable2 auxlist0_Nil
      by (auto simp: zero_enat_def[symmetric] sat_Since_rec[where i=ne]
          dest: spec[of _ σ (ne-1)"] elim!: qtable_cong[OF _ refl])
  next
    case (Cons a as)
    show ?thesis
    proof (cases "t = τ σ ne")
      case t: True
      show ?thesis
      proof (cases "fst a = τ σ ne")
        case True
        with auxlist' Cons t have "X = snd a  rel2"
          unfolding auxlist'_eq using sorted_auxlist0 by (auto split: if_splits)
        moreover from in_auxlist0_1[of "fst a" "snd a"] Cons have "ne  0"
          "fst a  τ σ (ne - 1)" σ ne - fst a  right I" "i. τ σ i = fst a"
          "qtable n (fv ψ) (mem_restr R) (λv. Formula.sat σ V (map the v) (ne - 1)
            (Sincep pos φ (point (τ σ (ne - 1) - fst a)) ψ)  (if pos then Formula.sat σ V (map the v) ne φ
              else ¬ Formula.sat σ V (map the v) ne φ)) (snd a)"
          by (auto simp: True[symmetric] zero_enat_def[symmetric])
        ultimately show ?thesis using qtable2 t True
          by (auto simp: sat_Since_rec[where i=ne] sat.simps(6) elim!: qtable_union)
      next
        case False
        with auxlist' Cons t have "X = rel2"
          unfolding auxlist'_eq using sorted_auxlist0 in_auxlist0_le_τ[of "fst a" "snd a"] by (auto split: if_splits)
        with auxlist' Cons t False show ?thesis
          unfolding auxlist'_eq using qtable2 in_auxlist0_2[of σ (ne-1)"] in_auxlist0_le_τ[of "fst a" "snd a"] sorted_auxlist0
          by (auto simp: sat_Since_rec[where i=ne] sat.simps(3) zero_enat_def[symmetric] enat_0_iff not_le
              elim!: qtable_cong[OF _ refl] dest!: le_τ_less meta_mp)
      qed
    next
      case False
      with auxlist' Cons have "(t, X)  set auxlist0"
        unfolding auxlist'_eq by (auto split: if_splits)
      then have "ne  0" "t  τ σ (ne - 1)" σ ne - t  right I" "i. τ σ i = t"
        "qtable n (fv ψ) (mem_restr R) (λv. Formula.sat σ V (map the v) (ne - 1) (Sincep pos φ (point (τ σ (ne - 1) - t)) ψ) 
           (if pos then Formula.sat σ V (map the v) ne φ else ¬ Formula.sat σ V (map the v) ne φ)) X"
        using in_auxlist0_1 by blast+
      with False auxlist' Cons show ?thesis
        unfolding auxlist'_eq using qtable2
        by (fastforce simp: sat_Since_rec[where i=ne] sat.simps(6)
            diff_diff_right[where i=σ ne" and j=σ _ + τ σ ne" and k=σ (ne - 1)",
              OF trans_le_add2, simplified] elim!: qtable_cong[OF _ refl] order_trans dest: le_τ_less)
    qed
  qed

  have in_auxlist'_2: "X. (t, X)  set auxlist'" if "t  τ σ ne" σ ne - t  right I" "i. τ σ i = t" for t
  proof (cases "t = τ σ ne")
    case True
    then show ?thesis
    proof (cases auxlist0)
      case Nil
      with True show ?thesis unfolding auxlist'_eq by (simp add: zero_enat_def[symmetric])
    next
      case (Cons a as)
      with True show ?thesis unfolding auxlist'_eq
        by (cases "fst a = τ σ ne") (auto simp: zero_enat_def[symmetric])
    qed
  next
    case False
    with that have "ne  0"
      using le_τ_less neq0_conv by blast
    moreover from False that have  "t  τ σ (ne-1)"
      by (metis One_nat_def Suc_leI Suc_pred τ_mono diff_is_0_eq' order.antisym neq0_conv not_le)
    ultimately obtain X where "(t, X)  set auxlist0" using ‹τ σ ne - t  right I i. τ σ i = t
      using τ_mono[of "ne - 1" "ne" σ] by (atomize_elim, cases "right I") (auto intro!: in_auxlist0_2 simp del: τ_mono)
    then show ?thesis unfolding auxlist'_eq using False ‹τ σ ne - t  right I
      by (auto intro: exI[of _ X] split: list.split)
  qed

  show "wf_since_aux σ V R args φ ψ aux' (Suc ne)"
    unfolding wf_since_aux_def args_ivl args_n args_pos
    by (auto simp add: fv_sub dest: in_auxlist'_1 intro: sorted_auxlist' in_auxlist'_2
        intro!: exI[of _ auxlist'] valid')

  have "rel = result_msaux args aux'"
    using result_eq by (auto simp add: update_since_def Let_def)
  with valid' have rel_eq: "rel = foldr (∪) [rel. (t, rel)  auxlist', left I  τ σ ne - t] {}"
    by (auto simp add: args_ivl valid_result_msaux
        intro!: arg_cong[where f = "λx. foldr (∪) (concat x) {}"] split: option.splits)
  have rel_alt: "rel = ((t, rel)  set auxlist'. if left I  τ σ ne - t then rel else empty_table)"
    unfolding rel_eq
    by (auto elim!: in_foldr_UnE bexI[rotated] intro!: in_foldr_UnI)
  show "qtable n (fv ψ) (mem_restr R) (λv. Formula.sat σ V (map the v) ne (Sincep pos φ I ψ)) rel"
    unfolding rel_alt
  proof (rule qtable_Union[where Qi="λ(t, X) v.
    left I  τ σ ne - t  Formula.sat σ V (map the v) ne (Sincep pos φ (point (τ σ ne - t)) ψ)"],
        goal_cases finite qtable equiv)
    case (equiv v)
    show ?case
    proof (rule iffI, erule sat_Since_point, goal_cases left right)
      case (left j)
      then show ?case using in_auxlist'_2[of σ j", OF _ _ exI, OF _ _ refl] by auto
    next
      case right
      then show ?case by (auto elim!: sat_Since_pointD dest: in_auxlist'_1)
    qed
  qed (auto dest!: in_auxlist'_1 intro!: qtable_empty)
qed

lemma fv_regex_from_mregex:
  "ok (length φs) mr  fv_regex (from_mregex mr φs)  (φ  set φs. fv φ)"
  by (induct mr) (auto simp: Bex_def in_set_conv_nth)+

lemma qtable_ε_lax:
  assumes "ok (length φs) mr"
    and "list_all2 (λφ rel. qtable n (Formula.fv φ) (mem_restr R) (λv. Formula.sat σ V (map the v) i φ) rel) φs rels"
    and "fv_regex (from_mregex mr φs)  A" and "qtable n A (mem_restr R) Q guard"
  shows "qtable n A (mem_restr R)
   (λv. Regex.eps (Formula.sat σ V (map the v)) i (from_mregex mr φs)  Q v) (ε_lax guard rels mr)"
  using assms
proof (induct mr)
  case (MPlus mr1 mr2)
  from MPlus(3-6) show ?case
    by (auto intro!: qtable_union[OF MPlus(1,2)])
next
  case (MTimes mr1 mr2)
  then have "fv_regex (from_mregex mr1 φs)  A" "fv_regex (from_mregex mr2 φs)  A"
    using fv_regex_from_mregex[of φs mr1] fv_regex_from_mregex[of φs mr2] by (auto simp: subset_eq)
  with MTimes(3-6) show ?case
    by (auto simp: eps_the_restrict restrict_idle intro!: qtable_join[OF MTimes(1,2)])
qed (auto split: prod.splits if_splits simp: qtable_empty_iff list_all2_conv_all_nth
    in_set_conv_nth restrict_idle sat_the_restrict
    intro: in_qtableI qtableI elim!: qtable_join[where A=A and C=A])

lemma nullary_qtable_cases: "qtable n {} P Q X  (X = empty_table  X = unit_table n)"
  by (simp add: qtable_def table_empty)

lemma qtable_empty_unit_table:
  "qtable n {} R P empty_table  qtable n {} R (λv. ¬ P v) (unit_table n)"
  by (auto intro: qtable_unit_table simp add: qtable_empty_iff)

lemma qtable_unit_empty_table:
  "qtable n {} R P (unit_table n)  qtable n {} R (λv. ¬ P v) empty_table"
  by (auto intro!: qtable_empty elim: in_qtableE simp add: wf_tuple_empty unit_table_def)

lemma qtable_nonempty_empty_table:
  "qtable n {} R P X  x  X  qtable n {} R (λv. ¬ P v) empty_table"
  by (frule nullary_qtable_cases) (auto dest: qtable_unit_empty_table)


lemma qtable_rε_strict:
  assumes "safe_regex Past Strict (from_mregex mr φs)" "ok (length φs) mr" "A = fv_regex (from_mregex mr φs)"
    and "list_all2 (λφ rel. qtable n (Formula.fv φ) (mem_restr R) (λv. Formula.sat σ V (map the v) i φ) rel) φs rels"
  shows "qtable n A (mem_restr R) (λv. Regex.eps (Formula.sat σ V (map the v)) i (from_mregex mr φs)) (rε_strict n rels mr)"
  using assms
proof (hypsubst, induct Past Strict "from_mregex mr φs" arbitrary: mr rule: safe_regex_induct)
  case (Skip n)
  then show ?case
    by (cases mr) (auto simp: qtable_empty_iff qtable_unit_table split: if_splits)
next
  case (Test φ)
  then show ?case
    by (cases mr) (auto simp: list_all2_conv_all_nth qtable_empty_unit_table
        dest!: qtable_nonempty_empty_table split: if_splits)
next
  case (Plus r s)
  then show ?case
    by (cases mr) (fastforce intro: qtable_union split: if_splits)+
next
  case (TimesP r s)
  then show ?case
    by (cases mr) (auto intro: qtable_cong[OF qtable_ε_lax] split: if_splits)+
next
  case (Star r)
  then show ?case
    by (cases mr) (auto simp: qtable_unit_table split: if_splits)
qed

lemma qtable_lε_strict:
  assumes "safe_regex Futu Strict (from_mregex mr φs)" "ok (length φs) mr" "A = fv_regex (from_mregex mr φs)"
    and "list_all2 (λφ rel. qtable n (Formula.fv φ) (mem_restr R) (λv. Formula.sat σ V (map the v) i φ) rel) φs rels"
  shows "qtable n A (mem_restr R) (λv. Regex.eps (Formula.sat σ V (map the v)) i (from_mregex mr φs)) (lε_strict n rels mr)"
  using assms
proof (hypsubst, induct Futu Strict "from_mregex mr φs" arbitrary: mr rule: safe_regex_induct)
  case (Skip n)
  then show ?case
    by (cases mr) (auto simp: qtable_empty_iff qtable_unit_table split: if_splits)
next
  case (Test φ)
  then show ?case
    by (cases mr) (auto simp: list_all2_conv_all_nth qtable_empty_unit_table
        dest!: qtable_nonempty_empty_table split: if_splits)
next
  case (Plus r s)
  then show ?case
    by (cases mr) (fastforce intro: qtable_union split: if_splits)+
next
  case (TimesF r s)
  then show ?case
    by (cases mr) (auto intro: qtable_cong[OF qtable_ε_lax] split: if_splits)+
next
  case (Star r)
  then show ?case
    by (cases mr) (auto simp: qtable_unit_table split: if_splits)
qed

lemma rtranclp_False: "(λi j. False)** = (=)"
proof -
  have "(λi j. False)** i j  i = j" for i j :: 'a
    by (induct i j rule: rtranclp.induct) auto
  then show ?thesis
    by (auto intro: exI[of _ 0])
qed

inductive ok_rctxt for φs where
  "ok_rctxt φs id id"
| "ok_rctxt φs κ κ'  ok_rctxt φs (λt. κ (MTimes mr t)) (λt. κ' (Regex.Times (from_mregex mr φs) t))"

lemma ok_rctxt_swap: "ok_rctxt φs κ κ'  from_mregex (κ mr) φs = κ' (from_mregex mr φs)"
  by (induct κ κ' arbitrary: mr rule: ok_rctxt.induct) auto

lemma ok_rctxt_cong: "ok_rctxt φs κ κ'  Regex.match (Formula.sat σ V v) r = Regex.match (Formula.sat σ V v) s 
  Regex.match (Formula.sat σ V v) (κ' r) i j = Regex.match (Formula.sat σ V v) (κ' s) i j"
  by (induct κ κ' arbitrary: r s rule: ok_rctxt.induct) simp_all

lemma qtable_rδκ:
  assumes "ok (length φs) mr" "fv_regex (from_mregex mr φs)  A"
    and "list_all2 (λφ rel. qtable n (Formula.fv φ) (mem_restr R) (λv. Formula.sat σ V (map the v) j φ) rel) φs rels"
    and "ok_rctxt φs κ κ'"
    and "ms  κ ` RPD mr. qtable n A (mem_restr R) (λv. Q (map the v) (from_mregex ms φs)) (lookup rel ms)"
  shows "qtable n A (mem_restr R)
  (λv. s  Regex.rpdκ κ' (Formula.sat σ V (map the v)) j (from_mregex mr φs). Q (map the v) s)
  (κ rel rels mr)"
  using assms
proof (induct mr arbitrary: κ κ')
  case MSkip
  then show ?case
    by (auto simp: rtranclp_False ok_rctxt_swap qtable_empty_iff
        elim!: qtable_cong[OF _ _ ok_rctxt_cong[of _ κ κ']] split: nat.splits)
next
  case (MPlus mr1 mr2)
  from MPlus(3-7) show ?case
    by (auto intro!: qtable_union[OF MPlus(1,2)])
next
  case (MTimes mr1 mr2)
  from MTimes(3-7) show ?case
    by (auto intro!: qtable_union[OF MTimes(2) qtable_ε_lax[OF _ _ _ MTimes(1)]]
        elim!: ok_rctxt.intros(2) simp: MTimesL_def Ball_def)
next
  case (MStar mr)
  from MStar(2-6) show ?case
    by (auto intro!: qtable_cong[OF MStar(1)] intro: ok_rctxt.intros simp: MTimesL_def Ball_def)
qed (auto simp: qtable_empty_iff)

lemmas qtable_rδ = qtable_rδκ[OF _ _ _ ok_rctxt.intros(1), unfolded rpdκ_rpd image_id id_apply]

inductive ok_lctxt for φs where
  "ok_lctxt φs id id"
| "ok_lctxt φs κ κ'  ok_lctxt φs (λt. κ (MTimes t mr)) (λt. κ' (Regex.Times t (from_mregex mr φs)))"

lemma ok_lctxt_swap: "ok_lctxt φs κ κ'  from_mregex (κ mr) φs = κ' (from_mregex mr φs)"
  by (induct κ κ' arbitrary: mr rule: ok_lctxt.induct) auto

lemma ok_lctxt_cong: "ok_lctxt φs κ κ'  Regex.match (Formula.sat σ V v) r = Regex.match (Formula.sat σ V v) s 
  Regex.match (Formula.sat σ V v) (κ' r) i j = Regex.match (Formula.sat σ V v) (κ' s) i j"
  by (induct κ κ' arbitrary: r s rule: ok_lctxt.induct) simp_all

lemma qtable_lδκ:
  assumes "ok (length φs) mr" "fv_regex (from_mregex mr φs)  A"
    and "list_all2 (λφ rel. qtable n (Formula.fv φ) (mem_restr R) (λv. Formula.sat σ V (map the v) j φ) rel) φs rels"
    and "ok_lctxt φs κ κ'"
    and "ms  κ ` LPD mr. qtable n A (mem_restr R) (λv. Q (map the v) (from_mregex ms φs)) (lookup rel ms)"
  shows "qtable n A (mem_restr R)
  (λv. s  Regex.lpdκ κ' (Formula.sat σ V (map the v)) j (from_mregex mr φs). Q (map the v) s)
  (κ rel rels mr)"
  using assms
proof (induct mr arbitrary: κ κ')
  case MSkip
  then show ?case
    by (auto simp: rtranclp_False ok_lctxt_swap qtable_empty_iff
        elim!: qtable_cong[OF _ _ ok_rctxt_cong[of _ κ κ']] split: nat.splits)
next
  case (MPlus mr1 mr2)
  from MPlus(3-7) show ?case
    by (auto intro!: qtable_union[OF MPlus(1,2)])
next
  case (MTimes mr1 mr2)
  from MTimes(3-7) show ?case
    by (auto intro!: qtable_union[OF MTimes(1) qtable_ε_lax[OF _ _ _ MTimes(2)]]
        elim!: ok_lctxt.intros(2) simp: MTimesR_def Ball_def)
next
  case (MStar mr)
  from MStar(2-6) show ?case
    by (auto intro!: qtable_cong[OF MStar(1)] intro: ok_lctxt.intros simp: MTimesR_def Ball_def)
qed (auto simp: qtable_empty_iff)

lemmas qtable_lδ = qtable_lδκ[OF _ _ _ ok_lctxt.intros(1), unfolded lpdκ_lpd image_id id_apply]

lemma RPD_fv_regex_le:
  "ms  RPD mr  fv_regex (from_mregex ms φs)  fv_regex (from_mregex mr φs)"
  by (induct mr arbitrary: ms) (auto simp: MTimesL_def split: nat.splits)+

lemma RPD_safe: "safe_regex Past g (from_mregex mr φs) 
  ms  RPD mr  safe_regex Past g (from_mregex ms φs)"
proof (induct Past g "from_mregex mr φs" arbitrary: mr ms rule: safe_regex_induct)
  case Skip
  then show ?case
    by (cases mr) (auto split: nat.splits)
next
  case (Test g φ)
  then show ?case
    by (cases mr) auto
next
  case (Plus g r s mrs)
  then show ?case
  proof (cases mrs)
    case (MPlus mr ms)
    with Plus(3-5) show ?thesis
      by (auto dest!: Plus(1,2))
  qed auto
next
  case (TimesP g r s mrs)
  then show ?case
  proof (cases mrs)
    case (MTimes mr ms)
    with TimesP(3-5) show ?thesis
      by (cases g) (auto 0 4 simp: MTimesL_def dest: RPD_fv_regex_le TimesP(1,2))
  qed auto
next
  case (Star g r)
  then show ?case
  proof (cases mr)
    case (MStar x6)
    with Star(2-4) show ?thesis
      by (cases g) (auto 0 4 simp: MTimesL_def dest: RPD_fv_regex_le
          elim!: safe_cosafe[rotated] dest!: Star(1))
  qed auto
qed

lemma RPDi_safe: "safe_regex Past g (from_mregex mr φs) 
  ms  RPDi n mr ==> safe_regex Past g (from_mregex ms φs)"
  by (induct n arbitrary: ms mr) (auto dest: RPD_safe)

lemma RPDs_safe: "safe_regex Past g (from_mregex mr φs) 
  ms  RPDs mr ==> safe_regex Past g (from_mregex ms φs)"
  unfolding RPDs_def by (auto dest: RPDi_safe)

lemma RPD_safe_fv_regex: "safe_regex Past Strict (from_mregex mr φs) 
  ms  RPD mr  fv_regex (from_mregex ms φs) = fv_regex (from_mregex mr φs)"
proof (induct Past Strict "from_mregex mr φs" arbitrary: mr rule: safe_regex_induct)
  case (Skip n)
  then show ?case
    by (cases mr) (auto split: nat.splits)
next
  case (Test φ)
  then show ?case
    by (cases mr) auto
next
  case (Plus r s)
  then show ?case
    by (cases mr) auto
next
  case (TimesP r s)
  then show ?case
    by (cases mr) (auto 0 3 simp: MTimesL_def dest: RPD_fv_regex_le split: modality.splits)
next
  case (Star r)
  then show ?case
    by (cases mr) (auto 0 3 simp: MTimesL_def dest: RPD_fv_regex_le)
qed

lemma RPDi_safe_fv_regex: "safe_regex Past Strict (from_mregex mr φs) 
  ms  RPDi n mr ==> fv_regex (from_mregex ms φs) = fv_regex (from_mregex mr φs)"
  by (induct n arbitrary: ms mr) (auto 5 0 dest: RPD_safe_fv_regex RPD_safe)

lemma RPDs_safe_fv_regex: "safe_regex Past Strict (from_mregex mr φs) 
  ms  RPDs mr ==> fv_regex (from_mregex ms φs) = fv_regex (from_mregex mr φs)"
  unfolding RPDs_def by (auto dest: RPDi_safe_fv_regex)

lemma RPD_ok: "ok m mr  ms  RPD mr  ok m ms"
proof (induct mr arbitrary: ms)
  case (MPlus mr1 mr2)
  from MPlus(3,4) show ?case
    by (auto elim: MPlus(1,2))
next
  case (MTimes mr1 mr2)
  from MTimes(3,4) show ?case
    by (auto elim: MTimes(1,2) simp: MTimesL_def)
next
  case (MStar mr)
  from MStar(2,3) show ?case
    by (auto elim: MStar(1) simp: MTimesL_def)
qed (auto split: nat.splits)

lemma RPDi_ok: "ok m mr  ms  RPDi n mr  ok m ms"
  by (induct n arbitrary: ms mr) (auto intro: RPD_ok)

lemma RPDs_ok: "ok m mr  ms  RPDs mr  ok m ms"
  unfolding RPDs_def by (auto intro: RPDi_ok)

lemma LPD_fv_regex_le:
  "ms  LPD mr  fv_regex (from_mregex ms φs)  fv_regex (from_mregex mr φs)"
  by (induct mr arbitrary: ms) (auto simp: MTimesR_def split: nat.splits)+

lemma LPD_safe: "safe_regex Futu g (from_mregex mr φs) 
  ms  LPD mr ==> safe_regex Futu g (from_mregex ms φs)"
proof (induct Futu g "from_mregex mr φs" arbitrary: mr ms rule: safe_regex_induct)
  case Skip
  then show ?case
    by (cases mr) (auto split: nat.splits)
next
  case (Test g φ)
  then show ?case
    by (cases mr) auto
next
  case (Plus g r s mrs)
  then show ?case
  proof (cases mrs)
    case (MPlus mr ms)
    with Plus(3-5) show ?thesis
      by (auto dest!: Plus(1,2))
  qed auto
next
  case (TimesF g r s mrs)
  then show ?case
  proof (cases mrs)
    case (MTimes mr ms)
    with TimesF(3-5) show ?thesis
      by (cases g) (auto 0 4 simp: MTimesR_def dest: LPD_fv_regex_le split: modality.splits dest: TimesF(1,2))
  qed auto
next
  case (Star g r)
  then show ?case
  proof (cases mr)
    case (MStar x6)
    with Star(2-4) show ?thesis
      by (cases g) (auto 0 4 simp: MTimesR_def dest: LPD_fv_regex_le
          elim!: safe_cosafe[rotated] dest!: Star(1))
  qed auto
qed

lemma LPDi_safe: "safe_regex Futu g (from_mregex mr φs) 
  ms  LPDi n mr ==> safe_regex Futu g (from_mregex ms φs)"
  by (induct n arbitrary: ms mr) (auto dest: LPD_safe)

lemma LPDs_safe: "safe_regex Futu g (from_mregex mr φs) 
  ms  LPDs mr ==> safe_regex Futu g (from_mregex ms φs)"
  unfolding LPDs_def by (auto dest: LPDi_safe)

lemma LPD_safe_fv_regex: "safe_regex Futu Strict (from_mregex mr φs) 
  ms  LPD mr ==> fv_regex (from_mregex ms φs) = fv_regex (from_mregex mr φs)"
proof (induct Futu Strict "from_mregex mr φs" arbitrary: mr rule: safe_regex_induct)
  case Skip
  then show ?case
    by (cases mr) (auto split: nat.splits)
next
  case (Test φ)
  then show ?case
    by (cases mr) auto
next
  case (Plus r s)
  then show ?case
    by (cases mr) auto
next
  case (TimesF r s)
  then show ?case
    by (cases mr) (auto 0 3 simp: MTimesR_def dest: LPD_fv_regex_le split: modality.splits)
next
  case (Star r)
  then show ?case
    by (cases mr) (auto 0 3 simp: MTimesR_def dest: LPD_fv_regex_le)
qed

lemma LPDi_safe_fv_regex: "safe_regex Futu Strict (from_mregex mr φs) 
  ms  LPDi n mr ==> fv_regex (from_mregex ms φs) = fv_regex (from_mregex mr φs)"
  by (induct n arbitrary: ms mr) (auto 5 0 dest: LPD_safe_fv_regex LPD_safe)

lemma LPDs_safe_fv_regex: "safe_regex Futu Strict (from_mregex mr φs) 
  ms  LPDs mr ==> fv_regex (from_mregex ms φs) = fv_regex (from_mregex mr φs)"
  unfolding LPDs_def by (auto dest: LPDi_safe_fv_regex)

lemma LPD_ok: "ok m mr  ms  LPD mr  ok m ms"
proof (induct mr arbitrary: ms)
  case (MPlus mr1 mr2)
  from MPlus(3,4) show ?case
    by (auto elim: MPlus(1,2))
next
  case (MTimes mr1 mr2)
  from MTimes(3,4) show ?case
    by (auto elim: MTimes(1,2) simp: MTimesR_def)
next
  case (MStar mr)
  from MStar(2,3) show ?case
    by (auto elim: MStar(1) simp: MTimesR_def)
qed (auto split: nat.splits)

lemma LPDi_ok: "ok m mr  ms  LPDi n mr  ok m ms"
  by (induct n arbitrary: ms mr) (auto intro: LPD_ok)

lemma LPDs_ok: "ok m mr  ms  LPDs mr  ok m ms"
  unfolding LPDs_def by (auto intro: LPDi_ok)

lemma update_matchP:
  assumes pre: "wf_matchP_aux σ V n R I r aux ne"
    and safe: "safe_regex Past Strict r"
    and mr: "to_mregex r = (mr, φs)"
    and mrs: "mrs = sorted_list_of_set (RPDs mr)"
    and qtables: "list_all2 (λφ rel. qtable n (Formula.fv φ) (mem_restr R) (λv. Formula.sat σ V (map the v) ne φ) rel) φs rels"
    and result_eq: "(rel, aux') = update_matchP n I mr mrs rels (τ σ ne) aux"
  shows "wf_matchP_aux σ V n R I r aux' (Suc ne)"
    and "qtable n (Formula.fv_regex r) (mem_restr R) (λv. Formula.sat σ V (map the v) ne (Formula.MatchP I r)) rel"
proof -
  let ?wf_tuple = "λv. wf_tuple n (Formula.fv_regex r) v"
  let ?update = "λrel t. mrtabulate mrs (λmr.
    rδ id rel rels mr  (if t = τ σ ne then rε_strict n rels mr else {}))"
  note sat.simps[simp del]

  define aux0 where "aux0 = [(t, ?update rel t). (t, rel)  aux, enat (τ σ ne - t)  right I]"
  have sorted_aux0: "sorted_wrt (λx y. fst x > fst y) aux0"
    using pre[unfolded wf_matchP_aux_def, THEN conjunct1]
    unfolding aux0_def
    by (induction aux) (auto simp add: sorted_wrt_append)
  { fix ms
    assume "ms  RPDs mr"
    then have "fv_regex (from_mregex ms φs) = fv_regex r"
      "safe_regex Past Strict (from_mregex ms φs)" "ok (length φs) ms" "RPD ms  RPDs mr"
      using safe RPDs_safe RPDs_safe_fv_regex mr from_mregex_to_mregex RPDs_ok to_mregex_ok RPDs_trans
      by fastforce+
  } note * = this
  have **: σ ne - (τ σ i + τ σ ne - τ σ (ne - Suc 0)) = τ σ (ne - Suc 0) - τ σ i" for i
    by (metis (no_types, lifting) Nat.diff_diff_right τ_mono add.commute add_diff_cancel_left diff_le_self le_add2 order_trans)
  have ***: σ i = τ σ ne"
    if  σ ne  τ σ i" σ i  τ σ (ne - Suc 0)" "ne > 0" for i
    by (metis (no_types, lifting) Suc_pred τ_mono diff_le_self le_τ_less le_antisym not_less_eq that)
  then have in_aux0_1: "(t, X)  set aux0  ne  0  t  τ σ ne  τ σ ne - t  right I 
      (i. τ σ i = t) 
      (msRPDs mr. qtable n (fv_regex r) (mem_restr R) (λv. Formula.sat σ V (map the v) ne
         (Formula.MatchP (point (τ σ ne - t)) (from_mregex ms φs))) (lookup X ms))" for t X
    unfolding aux0_def using safe mr mrs
    by (auto simp: lookup_tabulate map_of_map_restrict restrict_map_def finite_RPDs * ** RPDs_trans diff_le_mono2
        intro!: sat_MatchP_rec[of σ _ _ ne, THEN iffD2]
        qtable_union[OF qtable_rδ[OF _ _ qtables] qtable_rε_strict[OF _ _ _ qtables],
          of ms "fv_regex r" "λv r. Formula.sat σ V v (ne - Suc 0) (Formula.MatchP (point 0) r)" _ ms for ms]
        qtable_cong[OF qtable_rδ[OF _ _ qtables],
          of ms "fv_regex r" "λv r. Formula.sat σ V v (ne - Suc 0) (Formula.MatchP (point (τ σ (ne - Suc 0) - τ σ i)) r)"
          _ _  "(λv. Formula.sat σ V (map the v) ne (Formula.MatchP (point (τ σ ne - τ σ i))  (from_mregex ms φs)))" for ms i]
        dest!: assms(1)[unfolded wf_matchP_aux_def, THEN conjunct2, THEN conjunct1, rule_format]
        sat_MatchP_rec["of" σ _ _ ne, THEN iffD1]
        elim!: bspec order.trans[OF _ τ_mono] bexI[rotated] split: option.splits if_splits) (* slow 7 sec *)
  then have in_aux0_le_τ: "(t, X)  set aux0  t  τ σ ne" for t X
    by (meson τ_mono diff_le_self le_trans)
  have in_aux0_2: "ne  0  t  τ σ (ne-1)  τ σ ne - t  right I  i. τ σ i = t 
    X. (t, X)  set aux0" for t
  proof -
    fix t
    assume "ne  0" "t  τ σ (ne-1)" σ ne - t  right I" "i. τ σ i = t"
    then obtain X where "(t, X)  set aux"
      by (atomize_elim, intro assms(1)[unfolded wf_matchP_aux_def, THEN conjunct2, THEN conjunct2, rule_format])
        (auto simp: gr0_conv_Suc elim!: order_trans[rotated] intro!: diff_le_mono τ_mono)
    with ‹τ σ ne - t  right I have "(t, ?update X t)  set aux0"
      unfolding aux0_def by (auto simp: id_def elim!: bexI[rotated] intro!: exI[of _ X])
    then show "X. (t, X)  set aux0"
      by blast
  qed
  have aux0_Nil: "aux0 = []  ne = 0  ne  0  (t. t  τ σ (ne-1)  τ σ ne - t  right I 
        (i. τ σ i = t))"
    using in_aux0_2 by (cases "ne = 0") (auto)

  have aux'_eq: "aux' = (case aux0 of
      []  [(τ σ ne, mrtabulate mrs (rε_strict n rels))]
    | x # aux'  (if fst x = τ σ ne then x # aux'
       else (τ σ ne, mrtabulate mrs (rε_strict n rels)) # x # aux'))"
    using result_eq unfolding aux0_def update_matchP_def Let_def by simp
  have sorted_aux': "sorted_wrt (λx y. fst x > fst y) aux'"
    unfolding aux'_eq
    using sorted_aux0 in_aux0_le_τ by (cases aux0) (fastforce)+

  have in_aux'_1: "t  τ σ ne  τ σ ne - t  right I  (i. τ σ i = t) 
     (msRPDs mr. qtable n (Formula.fv_regex r) (mem_restr R) (λv.
        Formula.sat σ V (map the v) ne (Formula.MatchP (point (τ σ ne - t)) (from_mregex ms φs))) (lookup X ms))"
    if aux': "(t, X)  set aux'" for t X
  proof (cases aux0)
    case Nil
    with aux' show ?thesis
      unfolding aux'_eq using safe mrs qtables aux0_Nil *
      by (auto simp: zero_enat_def[symmetric] sat_MatchP_rec[where i=ne]
          lookup_tabulate finite_RPDs split: option.splits
          intro!: qtable_cong[OF qtable_rε_strict]
          dest: spec[of _ σ (ne-1)"])
  next
    case (Cons a as)
    show ?thesis
    proof (cases "t = τ σ ne")
      case t: True
      show ?thesis
      proof (cases "fst a = τ σ ne")
        case True
        with aux' Cons t have "X = snd a"
          unfolding aux'_eq using sorted_aux0 by auto
        moreover from in_aux0_1[of "fst a" "snd a"] Cons have "ne  0"
          "fst a  τ σ ne" σ ne - fst a  right I" "i. τ σ i = fst a"
          "ms  RPDs mr. qtable n (fv_regex r) (mem_restr R) (λv. Formula.sat σ V (map the v) ne
            (Formula.MatchP (point (τ σ ne - fst a)) (from_mregex ms φs))) (lookup (snd a) ms)"
          by auto
        ultimately show ?thesis using t True
          by auto
      next
        case False
        with aux' Cons t have "X = mrtabulate mrs (rε_strict n rels)"
          unfolding aux'_eq using sorted_aux0 in_aux0_le_τ[of "fst a" "snd a"] by auto
        with aux' Cons t False show ?thesis
          unfolding aux'_eq using safe mrs qtables * in_aux0_2[of σ (ne-1)"] in_aux0_le_τ[of "fst a" "snd a"] sorted_aux0
          by (auto simp: sat_MatchP_rec[where i=ne] zero_enat_def[symmetric] enat_0_iff not_le
              lookup_tabulate finite_RPDs split: option.splits
              intro!: qtable_cong[OF qtable_rε_strict] dest!: le_τ_less meta_mp)
      qed
    next
      case False
      with aux' Cons have "(t, X)  set aux0"
        unfolding aux'_eq by (auto split: if_splits)
      then have "ne  0" "t  τ σ ne" σ ne - t  right I" "i. τ σ i = t"
        "ms  RPDs mr. qtable n (fv_regex r) (mem_restr R) (λv. Formula.sat σ V (map the v) ne
          (Formula.MatchP (point (τ σ ne - t)) (from_mregex ms φs))) (lookup X ms)"
        using in_aux0_1 by blast+
      with False aux' Cons show ?thesis
        unfolding aux'_eq by auto
    qed
  qed

  have in_aux'_2: "X. (t, X)  set aux'" if "t  τ σ ne" σ ne - t  right I" "i. τ σ i = t" for t
  proof (cases "t = τ σ ne")
    case True
    then show ?thesis
    proof (cases aux0)
      case Nil
      with True show ?thesis unfolding aux'_eq by simp
    next
      case (Cons a as)
      with True show ?thesis unfolding aux'_eq using eq_fst_iff[of t a]
        by (cases "fst a = τ σ ne") auto
    qed
  next
    case False
    with that have "ne  0"
      using le_τ_less neq0_conv by blast
    moreover from False that have  "t  τ σ (ne-1)"
      by (metis One_nat_def Suc_leI Suc_pred τ_mono diff_is_0_eq' order.antisym neq0_conv not_le)
    ultimately obtain X where "(t, X)  set aux0" using ‹τ σ ne - t  right I i. τ σ i = t
      by atomize_elim (auto intro!: in_aux0_2)
    then show ?thesis unfolding aux'_eq using False
      by (auto intro: exI[of _ X] split: list.split)
  qed

  show "wf_matchP_aux σ V n R I r aux' (Suc ne)"
    unfolding wf_matchP_aux_def using mr
    by (auto dest: in_aux'_1 intro: sorted_aux' in_aux'_2)

  have rel_eq: "rel = foldr (∪) [lookup rel mr. (t, rel)  aux', left I  τ σ ne - t] {}"
    unfolding aux'_eq aux0_def
    using result_eq by (simp add: update_matchP_def Let_def)
  have rel_alt: "rel = ((t, rel)  set aux'. if left I  τ σ ne - t then lookup rel mr else empty_table)"
    unfolding rel_eq
    by (auto elim!: in_foldr_UnE bexI[rotated] intro!: in_foldr_UnI)
  show "qtable n (fv_regex r) (mem_restr R) (λv. Formula.sat σ V (map the v) ne (Formula.MatchP I r)) rel"
    unfolding rel_alt
  proof (rule qtable_Union[where Qi="λ(t, X) v.
    left I  τ σ ne - t  Formula.sat σ V (map the v) ne (Formula.MatchP (point (τ σ ne - t)) r)"],
        goal_cases finite qtable equiv)
    case (equiv v)
    show ?case
    proof (rule iffI, erule sat_MatchP_point, goal_cases left right)
      case (left j)
      then show ?case using in_aux'_2[of σ j", OF _ _ exI, OF _ _ refl] by auto
    next
      case right
      then show ?case by (auto elim!: sat_MatchP_pointD dest: in_aux'_1)
    qed
  qed (auto dest!: in_aux'_1 intro!: qtable_empty dest!: bspec[OF _ RPDs_refl]
      simp: from_mregex_eq[OF safe mr])
qed

lemma length_update_until: "length (update_until args rel1 rel2 nt aux) = Suc (length aux)"
  unfolding update_until_def by simp

lemma wf_update_until_auxlist:
  assumes pre: "wf_until_auxlist σ V n R pos φ I ψ auxlist ne"
    and qtable1: "qtable n (Formula.fv φ) (mem_restr R) (λv. Formula.sat σ V (map the v) (ne + length auxlist) φ) rel1"
    and qtable2: "qtable n (Formula.fv ψ) (mem_restr R) (λv. Formula.sat σ V (map the v) (ne + length auxlist) ψ) rel2"
    and fvi_subset: "Formula.fv φ  Formula.fv ψ"
    and args_ivl: "args_ivl args = I"
    and args_n: "args_n args = n"
    and args_pos: "args_pos args = pos"
  shows "wf_until_auxlist σ V n R pos φ I ψ (update_until args rel1 rel2 (τ σ (ne + length auxlist)) auxlist) ne"
  unfolding wf_until_auxlist_def length_update_until
  unfolding update_until_def list.rel_map add_Suc_right upt.simps eqTrueI[OF le_add1] if_True
proof (rule list_all2_appendI, unfold list.rel_map, goal_cases old new)
  case old
  show ?case
  proof (rule list.rel_mono_strong[OF assms(1)[unfolded wf_until_auxlist_def]]; safe, goal_cases mono1 mono2)
    case (mono1 i X Y v)
    then show ?case
      by (fastforce simp: args_ivl args_n args_pos sat_the_restrict less_Suc_eq
          elim!: qtable_join[OF _ qtable1] qtable_union[OF _ qtable1])
  next
    case (mono2 i X Y v)
    then show ?case using fvi_subset
      by (auto 0 3 simp: args_ivl args_n args_pos sat_the_restrict less_Suc_eq split: if_splits
          elim!: qtable_union[OF _ qtable_join_fixed[OF qtable2]]
          elim: qtable_cong[OF _ refl] intro: exI[of _ "ne + length auxlist"]) (* slow 8 sec*)
  qed
next
  case new
  then show ?case
    by (auto intro!: qtable_empty qtable1 qtable2[THEN qtable_cong] exI[of _ "ne + length auxlist"]
        simp: args_ivl args_n args_pos less_Suc_eq zero_enat_def[symmetric])
qed

lemma (in muaux) wf_update_until:
  assumes pre: "wf_until_aux σ V R args φ ψ aux ne"
    and qtable1: "qtable n (Formula.fv φ) (mem_restr R) (λv. Formula.sat σ V (map the v) (ne + length_muaux args aux) φ) rel1"
    and qtable2: "qtable n (Formula.fv ψ) (mem_restr R) (λv. Formula.sat σ V (map the v) (ne + length_muaux args aux) ψ) rel2"
    and fvi_subset: "Formula.fv φ  Formula.fv ψ"
    and args_ivl: "args_ivl args = I"
    and args_n: "args_n args = n"
    and args_L: "args_L args = Formula.fv φ"
    and args_R: "args_R args = Formula.fv ψ"
    and args_pos: "args_pos args = pos"
  shows "wf_until_aux σ V R args φ ψ (add_new_muaux args rel1 rel2 (τ σ (ne + length_muaux args aux)) aux) ne 
      length_muaux args (add_new_muaux args rel1 rel2 (τ σ (ne + length_muaux args aux)) aux) = Suc (length_muaux args aux)"
proof -
  from pre obtain cur auxlist where valid_aux: "valid_muaux args cur aux auxlist" and
    cur: "cur = (if ne + length auxlist = 0 then 0 else τ σ (ne + length auxlist - 1))" and
    pre_list: "wf_until_auxlist σ V n R pos φ I ψ auxlist ne"
    unfolding wf_until_aux_def args_ivl args_n args_pos by auto
  have length_aux: "length_muaux args aux = length auxlist"
    using valid_length_muaux[OF valid_aux] .
  define nt where "nt  τ σ (ne + length_muaux args aux)"
  have nt_mono: "cur  nt"
    unfolding cur nt_def length_aux by simp
  define auxlist' where "auxlist'  update_until args rel1 rel2 (τ σ (ne + length auxlist)) auxlist"
  have length_auxlist': "length auxlist' = Suc (length auxlist)"
    unfolding auxlist'_def by (auto simp add: length_update_until)
  have tab1: "table (args_n args) (args_L args) rel1"
    using qtable1 unfolding args_n[symmetric] args_L[symmetric] by (auto simp add: qtable_def)
  have tab2: "table (args_n args) (args_R args) rel2"
    using qtable2 unfolding args_n[symmetric] args_R[symmetric] by (auto simp add: qtable_def)
  have fv_sub: "fv φ  fv ψ"
    using pre unfolding wf_until_aux_def by auto
  moreover have valid_add_new_auxlist: "valid_muaux args nt (add_new_muaux args rel1 rel2 nt aux) auxlist'"
    using valid_add_new_muaux[OF valid_aux tab1 tab2 nt_mono]
    unfolding auxlist'_def nt_def length_aux .
  moreover have "length_muaux args (add_new_muaux args rel1 rel2 nt aux) = Suc (length_muaux args aux)"
    using valid_length_muaux[OF valid_add_new_auxlist] unfolding length_auxlist' length_aux[symmetric] .
  moreover have "wf_until_auxlist σ V n R pos φ I ψ auxlist' ne"
    using wf_update_until_auxlist[OF pre_list qtable1[unfolded length_aux] qtable2[unfolded length_aux] fv_sub args_ivl args_n args_pos]
    unfolding auxlist'_def .
  moreover have σ (ne + length auxlist) = (if ne + length auxlist' = 0 then 0 else τ σ (ne + length auxlist' - 1))"
    unfolding cur length_auxlist' by auto
  ultimately show ?thesis
    unfolding wf_until_aux_def nt_def length_aux args_ivl args_n args_pos by fast
qed

lemma length_update_matchF_base:
  "length (fst (update_matchF_base I mr mrs nt entry st)) = Suc 0"
  by (auto simp: Let_def update_matchF_base_def)

lemma length_update_matchF_step:
  "length (fst (update_matchF_step I mr mrs nt entry st)) = Suc (length (fst st))"
  by (auto simp: Let_def update_matchF_step_def split: prod.splits)

lemma length_foldr_update_matchF_step:
  "length (fst (foldr (update_matchF_step I mr mrs nt) aux base)) = length aux + length (fst base)"
  by (induct aux arbitrary: base) (auto simp: Let_def length_update_matchF_step)

lemma length_update_matchF: "length (update_matchF n I mr mrs rels nt aux) = Suc (length aux)"
  unfolding update_matchF_def update_matchF_base_def length_foldr_update_matchF_step
  by (auto simp: Let_def)

lemma wf_update_matchF_base_invar:
  assumes safe: "safe_regex Futu Strict r"
    and mr: "to_mregex r = (mr, φs)"
    and mrs: "mrs = sorted_list_of_set (LPDs mr)"
    and qtables: "list_all2 (λφ rel. qtable n (Formula.fv φ) (mem_restr R) (λv. Formula.sat σ V (map the v) j φ) rel) φs rels"
  shows "wf_matchF_invar σ V n R I r (update_matchF_base n I mr mrs rels (τ σ j)) j"
proof -
  have from_mregex: "from_mregex mr φs = r"
    using safe mr using from_mregex_eq by blast
  { fix ms
    assume "ms  LPDs mr"
    then have "fv_regex (from_mregex ms φs) = fv_regex r"
      "safe_regex Futu Strict (from_mregex ms φs)" "ok (length φs) ms" "LPD ms  LPDs mr"
      using safe LPDs_safe LPDs_safe_fv_regex mr from_mregex_to_mregex LPDs_ok to_mregex_ok LPDs_trans
      by fastforce+
  } note * = this
  show ?thesis
    unfolding wf_matchF_invar_def wf_matchF_aux_def update_matchF_base_def mr prod.case Let_def mrs
    using safe
    by (auto simp: * from_mregex qtables qtable_empty_iff zero_enat_def[symmetric]
        lookup_tabulate finite_LPDs eps_match less_Suc_eq LPDs_refl
        intro!: qtable_cong[OF qtable_lε_strict[where φs=φs]] intro: qtables exI[of _ j]
        split: option.splits)
qed

lemma Un_empty_table[simp]: "rel  empty_table = rel" "empty_table  rel = rel"
  unfolding empty_table_def by auto

lemma wf_matchF_invar_step:
  assumes wf: "wf_matchF_invar σ V n R I r st (Suc i)"
    and safe: "safe_regex Futu Strict r"
    and mr: "to_mregex r = (mr, φs)"
    and mrs: "mrs = sorted_list_of_set (LPDs mr)"
    and qtables: "list_all2 (λφ rel. qtable n (Formula.fv φ) (mem_restr R) (λv. Formula.sat σ V (map the v) i φ) rel) φs rels"
    and rel: "qtable n (Formula.fv_regex r) (mem_restr R) (λv. (j. i  j  j < i + length (fst st)  mem (τ σ j - τ σ i) I 
          Regex.match (Formula.sat σ V (map the v)) r i j)) rel"
    and entry: "entry = (τ σ i, rels, rel)"
    and nt: "nt = τ σ (i + length (fst st))"
  shows "wf_matchF_invar σ V n R I r (update_matchF_step I mr mrs nt entry st) i"
proof -
  have from_mregex: "from_mregex mr φs = r"
    using safe mr using from_mregex_eq by blast
  { fix ms
    assume "ms  LPDs mr"
    then have "fv_regex (from_mregex ms φs) = fv_regex r"
      "safe_regex Futu Strict (from_mregex ms φs)" "ok (length φs) ms" "LPD ms  LPDs mr"
      using safe LPDs_safe LPDs_safe_fv_regex mr from_mregex_to_mregex LPDs_ok to_mregex_ok LPDs_trans
      by fastforce+
  } note * = this
  { fix aux X ms
    assume "st = (aux, X)" "ms  LPDs mr"
    with wf mr have "qtable n (fv_regex r) (mem_restr R)
      (λv. Regex.match (Formula.sat σ V (map the v)) (from_mregex ms φs) i (i + length aux))
      ((λx. x) X rels ms)"
      by (intro qtable_cong[OF qtable_lδ[where φs=φs and A="fv_regex r" and
              Q="λv r. Regex.match (Formula.sat σ V v) r (Suc i) (i + length aux)", OF _ _ qtables]])
        (auto simp: wf_matchF_invar_def * LPDs_trans lpd_match[of i] elim!: bspec)
  } note= this
  have "lookup (mrtabulate mrs f) ms = f ms" if "ms  LPDs mr" for ms and f :: "mregex  'a table"
    using that mrs  by (fastforce simp: lookup_tabulate finite_LPDs split: option.splits)+
  then show ?thesis
    using wf mr mrs entry nt LPDs_trans
    by (auto 0 3 simp: Let_def wf_matchF_invar_def update_matchF_step_def wf_matchF_aux_def mr * LPDs_refl
        list_all2_Cons1 append_eq_Cons_conv upt_eq_Cons_conv Suc_le_eq qtables
        lookup_tabulate finite_LPDs id_def lδ from_mregex less_Suc_eq
        intro!: qtable_union[OF rel lδ] qtable_cong[OF rel]
        intro: exI[of _ "i + length _"]
        split: if_splits prod.splits)
qed

lemma wf_update_matchF_invar:
  assumes pre: "wf_matchF_aux σ V n R I r aux ne (length (fst st) - 1)"
    and wf: "wf_matchF_invar σ V n R I r st (ne + length aux)"
    and safe: "safe_regex Futu Strict r"
    and mr: "to_mregex r = (mr, φs)"
    and mrs: "mrs = sorted_list_of_set (LPDs mr)"
    and j: "j = ne + length aux + length (fst st) - 1"
  shows "wf_matchF_invar σ V n R I r (foldr (update_matchF_step I mr mrs (τ σ j)) aux st) ne"
  using pre wf unfolding j
proof (induct aux arbitrary: ne)
  case (Cons entry aux)
  from Cons(1)[of "Suc ne"] Cons(2,3) show ?case
    unfolding foldr.simps o_apply
    by (intro wf_matchF_invar_step[where rels = "fst (snd entry)" and rel = "snd (snd entry)"])
      (auto simp: safe mr mrs wf_matchF_aux_def wf_matchF_invar_def list_all2_Cons1 append_eq_Cons_conv
        Suc_le_eq upt_eq_Cons_conv length_foldr_update_matchF_step add.assoc split: if_splits)
qed simp


lemma wf_update_matchF:
  assumes pre: "wf_matchF_aux σ V n R I r aux ne 0"
    and safe: "safe_regex Futu Strict r"
    and mr: "to_mregex r = (mr, φs)"
    and mrs: "mrs = sorted_list_of_set (LPDs mr)"
    and nt: "nt = τ σ (ne + length aux)"
    and qtables: "list_all2 (λφ rel. qtable n (Formula.fv φ) (mem_restr R) (λv. Formula.sat σ V (map the v) (ne + length aux) φ) rel) φs rels"
  shows "wf_matchF_aux σ V n R I r (update_matchF n I mr mrs rels nt aux) ne 0"
  unfolding update_matchF_def using wf_update_matchF_base_invar[OF safe mr mrs qtables, of I]
  unfolding nt
  by (intro wf_update_matchF_invar[OF _ _ safe mr mrs, unfolded wf_matchF_invar_def split_beta, THEN conjunct2, THEN conjunct1])
    (auto simp: length_update_matchF_base wf_matchF_invar_def update_matchF_base_def Let_def pre)

lemma wf_until_aux_Cons: "wf_until_auxlist σ V n R pos φ I ψ (a # aux) ne 
  wf_until_auxlist σ V n R pos φ I ψ aux (Suc ne)"
  unfolding wf_until_auxlist_def
  by (simp add: upt_conv_Cons del: upt_Suc cong: if_cong)

lemma wf_matchF_aux_Cons: "wf_matchF_aux σ V n R I r (entry # aux) ne i 
  wf_matchF_aux σ V n R I r aux (Suc ne) i"
  unfolding wf_matchF_aux_def
  by (simp add: upt_conv_Cons del: upt_Suc cong: if_cong split: prod.splits)

lemma wf_until_aux_Cons1: "wf_until_auxlist σ V n R pos φ I ψ ((t, a1, a2) # aux) ne  t = τ σ ne"
  unfolding wf_until_auxlist_def
  by (simp add: upt_conv_Cons del: upt_Suc)

lemma wf_matchF_aux_Cons1: "wf_matchF_aux σ V n R I r ((t, rels, rel) # aux) ne i  t = τ σ ne"
  unfolding wf_matchF_aux_def
  by (simp add: upt_conv_Cons del: upt_Suc split: prod.splits)

lemma wf_until_aux_Cons3: "wf_until_auxlist σ V n R pos φ I ψ ((t, a1, a2) # aux) ne 
  qtable n (Formula.fv ψ) (mem_restr R) (λv. (j. ne  j  j < Suc (ne + length aux)  mem (τ σ j - τ σ ne) I 
    Formula.sat σ V (map the v) j ψ  (k{ne..<j}. if pos then Formula.sat σ V (map the v) k φ else ¬ Formula.sat σ V (map the v) k φ))) a2"
  unfolding wf_until_auxlist_def
  by (simp add: upt_conv_Cons del: upt_Suc)

lemma wf_matchF_aux_Cons3: "wf_matchF_aux σ V n R I r ((t, rels, rel) # aux) ne i 
  qtable n (Formula.fv_regex r) (mem_restr R) (λv. (j. ne  j  j < Suc (ne + length aux + i)  mem (τ σ j - τ σ ne) I 
    Regex.match (Formula.sat σ V (map the v)) r ne j)) rel"
  unfolding wf_matchF_aux_def
  by (simp add: upt_conv_Cons del: upt_Suc split: prod.splits)

lemma upt_append: "a  b  b  c  [a..<b] @ [b..<c] = [a..<c]"
  by (metis le_Suc_ex upt_add_eq_append)

lemma wf_mbuf2_add:
  assumes "wf_mbuf2 i ja jb P Q buf"
    and "list_all2 P [ja..<ja'] xs"
    and "list_all2 Q [jb..<jb'] ys"
    and "ja  ja'" "jb  jb'"
  shows "wf_mbuf2 i ja' jb' P Q (mbuf2_add xs ys buf)"
  using assms unfolding wf_mbuf2_def
  by (auto 0 3 simp: list_all2_append2 upt_append dest: list_all2_lengthD
      intro: exI[where x="[i..<ja]"] exI[where x="[ja..<ja']"]
      exI[where x="[i..<jb]"] exI[where x="[jb..<jb']"] split: prod.splits)

lemma wf_mbufn_add:
  assumes "wf_mbufn i js Ps buf"
    and "list_all3 list_all2 Ps (List.map2 (λj j'. [j..<j']) js js') xss"
    and "list_all2 (≤) js js'"
  shows "wf_mbufn i js' Ps (mbufn_add xss buf)"
  unfolding wf_mbufn_def list_all3_conv_all_nth
proof safe
  show "length Ps = length js'" "length js' = length (mbufn_add xss buf)"
    using assms unfolding wf_mbufn_def list_all3_conv_all_nth list_all2_conv_all_nth by auto
next
  fix k assume k: "k < length Ps"
  then show "i  js' ! k"
    using assms unfolding wf_mbufn_def list_all3_conv_all_nth list_all2_conv_all_nth
    by (auto 0 4 dest: spec[of _ i])
  from k have " [i..<js' ! k] =  [i..<js ! k] @ [js ! k ..<js' ! k]" and
    "length [i..<js ! k] = length (buf ! k)"
    using assms(1,3) unfolding wf_mbufn_def list_all3_conv_all_nth list_all2_conv_all_nth
    by (auto simp: upt_append)
  with k show "list_all2 (Ps ! k) [i..<js' ! k] (mbufn_add xss buf ! k)"
    using assms[unfolded wf_mbufn_def list_all3_conv_all_nth]
    by (auto simp add: list_all2_append)
qed

lemma mbuf2_take_eqD:
  assumes "mbuf2_take f buf = (xs, buf')"
    and "wf_mbuf2 i ja jb P Q buf"
  shows "wf_mbuf2 (min ja jb) ja jb P Q buf'"
    and "list_all2 (λi z. x y. P i x  Q i y  z = f x y) [i..<min ja jb] xs"
  using assms unfolding wf_mbuf2_def
  by (induction f buf arbitrary: i xs buf' rule: mbuf2_take.induct)
    (fastforce simp add: list_all2_Cons2 upt_eq_Cons_conv min_absorb1 min_absorb2 split: prod.splits)+

lemma list_all3_Nil[simp]:
  "list_all3 P xs ys []  xs = []  ys = []"
  "list_all3 P xs [] zs  xs = []  zs = []"
  "list_all3 P [] ys zs  ys = []  zs = []"
  unfolding list_all3_conv_all_nth by auto

lemma list_all3_Cons:
  "list_all3 P xs ys (z # zs)  (x xs' y ys'. xs = x # xs'  ys = y # ys'  P x y z  list_all3 P xs' ys' zs)"
  "list_all3 P xs (y # ys) zs  (x xs' z zs'. xs = x # xs'  zs = z # zs'  P x y z  list_all3 P xs' ys zs')"
  "list_all3 P (x # xs) ys zs  (y ys' z zs'. ys = y # ys'  zs = z # zs'  P x y z  list_all3 P xs ys' zs')"
  unfolding list_all3_conv_all_nth
  by (auto simp: length_Suc_conv Suc_length_conv nth_Cons split: nat.splits)

lemma list_all3_mono_strong: "list_all3 P xs ys zs 
  (x y z. x  set xs  y  set ys  z  set zs  P x y z  Q x y z) 
  list_all3 Q xs ys zs"
  by (induct xs ys zs rule: list_all3.induct) (auto intro: list_all3.intros)

definition Mini where
  "Mini i js = (if js = [] then i else Min (set js))"

lemma wf_mbufn_in_set_Mini:
  assumes "wf_mbufn i js Ps buf"
  shows "[]  set buf  Mini i js = i"
  unfolding in_set_conv_nth
proof (elim exE conjE)
  fix k
  have "i  j" if "j  set js" for j
    using that assms unfolding wf_mbufn_def list_all3_conv_all_nth in_set_conv_nth by auto
  moreover assume "k < length buf" "buf ! k = []"
  ultimately show ?thesis using assms
    unfolding Mini_def wf_mbufn_def list_all3_conv_all_nth
    by (auto 0 4 dest!: spec[of _ k] intro: Min_eqI simp: in_set_conv_nth)
qed

lemma wf_mbufn_notin_set:
  assumes "wf_mbufn i js Ps buf"
  shows "[]  set buf  j  set js  i < j"
  using assms unfolding wf_mbufn_def list_all3_conv_all_nth
  by (cases "i  set js") (auto intro: le_neq_implies_less simp: in_set_conv_nth)

lemma wf_mbufn_map_tl:
  "wf_mbufn i js Ps buf  []  set buf  wf_mbufn (Suc i) js Ps (map tl buf)"
  by (auto simp: wf_mbufn_def list_all3_map Suc_le_eq
      dest: rel_funD[OF tl_transfer]  elim!: list_all3_mono_strong le_neq_implies_less)

lemma list_all3_list_all2I: "list_all3 (λx y z. Q x z) xs ys zs  list_all2 Q xs zs"
  by (induct xs ys zs rule: list_all3.induct) auto

lemma mbuf2t_take_eqD:
  assumes "mbuf2t_take f z buf nts = (z', buf', nts')"
    and "wf_mbuf2 i ja jb P Q buf"
    and "list_all2 R [i..<j] nts"
    and "ja  j" "jb  j"
  shows "wf_mbuf2 (min ja jb) ja jb P Q buf'"
    and "list_all2 R [min ja jb..<j] nts'"
  using assms unfolding wf_mbuf2_def
  by (induction f z buf nts arbitrary: i z' buf' nts' rule: mbuf2t_take.induct)
    (auto simp add: list_all2_Cons2 upt_eq_Cons_conv less_eq_Suc_le min_absorb1 min_absorb2
      split: prod.split)

lemma wf_mbufn_take:
  assumes "mbufn_take f z buf = (z', buf')"
    and "wf_mbufn i js Ps buf"
  shows "wf_mbufn (Mini i js) js Ps buf'"
  using assms unfolding wf_mbufn_def
proof (induction f z buf arbitrary: i z' buf' rule: mbufn_take.induct)
  case rec: (1 f z buf)
  show ?case proof (cases "buf = []")
    case True
    with rec.prems show ?thesis by simp
  next
    case nonempty: False
    show ?thesis proof (cases "[]  set buf")
      case True
      from rec.prems(2) have "jset js. i  j"
        by (auto simp: in_set_conv_nth list_all3_conv_all_nth)
      moreover from True rec.prems(2) have "i  set js"
        by (fastforce simp: in_set_conv_nth list_all3_conv_all_nth list_all2_iff)
      ultimately have "Mini i js = i"
        unfolding Mini_def
        by (auto intro!: antisym[OF Min.coboundedI Min.boundedI])
      with rec.prems nonempty True show ?thesis by simp
    next
      case False
      from nonempty rec.prems(2) have "Mini i js = Mini (Suc i) js"
        unfolding Mini_def by auto
      show ?thesis
        unfolding ‹Mini i js = Mini (Suc i) js
      proof (rule rec.IH)
        show "¬ (buf = []  []  set buf)" using nonempty False by simp
        show "list_all3 (λP j xs. Suc i  j  list_all2 P [Suc i..<j] xs) Ps js (map tl buf)"
          using False rec.prems(2)
          by (auto simp: list_all3_map elim!: list_all3_mono_strong dest: list.rel_sel[THEN iffD1])
        show "mbufn_take f (f (map hd buf) z) (map tl buf) = (z', buf')"
          using nonempty False rec.prems(1) by simp
      qed
    qed
  qed
qed

lemma mbufnt_take_eqD:
  assumes "mbufnt_take f z buf nts = (z', buf', nts')"
    and "wf_mbufn i js Ps buf"
    and "list_all2 R [i..<j] nts"
    and "k. k  set js  k  j"
    and "k = Mini (i + length nts) js"
  shows "wf_mbufn k js Ps buf'"
    and "list_all2 R [k..<j] nts'"
  using assms(1-4) unfolding assms(5)
proof (induction f z buf nts arbitrary: i z' buf' nts' rule: mbufnt_take.induct)
  case IH: (1 f z buf nts)
  note mbufnt_take.simps[simp del]
  case 1
  then have *: "list_all2 R [Suc i..<j] (tl nts)"
    by (auto simp: list.rel_sel[of R "[i..<j]" nts, simplified])
  from 1 show ?case
    using wf_mbufn_in_set_Mini[OF 1(2)]
    by (subst (asm) mbufnt_take.simps)
      (force simp: Mini_def wf_mbufn_def split: if_splits prod.splits elim!: list_all3_mono_strong
        dest!: IH(1)[rotated, OF _ wf_mbufn_map_tl[OF 1(2)] *])
  case 2
  then have *: "list_all2 R [Suc i..<j] (tl nts)"
    by (auto simp: list.rel_sel[of R "[i..<j]" nts, simplified])
  have [simp]: "Suc (i + (length nts - Suc 0)) = i + length nts" if "nts  []"
    using that by (fastforce simp flip: length_greater_0_conv)
  with 2 show ?case
    using wf_mbufn_in_set_Mini[OF 2(2)] wf_mbufn_notin_set[OF 2(2)]
    by (subst (asm) mbufnt_take.simps) (force simp: Mini_def wf_mbufn_def
        dest!: IH(2)[rotated, OF _ wf_mbufn_map_tl[OF 2(2)] *]
        split: if_splits prod.splits)
qed

lemma mbuf2t_take_induct[consumes 5, case_names base step]:
  assumes "mbuf2t_take f z buf nts = (z', buf', nts')"
    and "wf_mbuf2 i ja jb P Q buf"
    and "list_all2 R [i..<j] nts"
    and "ja  j" "jb  j"
    and "U i z"
    and "k x y t z. i  k  Suc k  ja  Suc k  jb 
      P k x  Q k y  R k t  U k z  U (Suc k) (f x y t z)"
  shows "U (min ja jb) z'"
  using assms unfolding wf_mbuf2_def
  by (induction f z buf nts arbitrary: i z' buf' nts' rule: mbuf2t_take.induct)
    (auto simp add: list_all2_Cons2 upt_eq_Cons_conv less_eq_Suc_le min_absorb1 min_absorb2
      elim!: arg_cong2[of _ _ _ _ U, OF _ refl, THEN iffD1, rotated] split: prod.split)

lemma list_all2_hdD:
  assumes "list_all2 P [i..<j] xs" "xs  []"
  shows "P i (hd xs)" "i < j"
  using assms unfolding list_all2_conv_all_nth
  by (auto simp: hd_conv_nth intro: zero_less_diff[THEN iffD1] dest!: spec[of _ 0])

lemma mbufn_take_induct[consumes 3, case_names base step]:
  assumes "mbufn_take f z buf = (z', buf')"
    and "wf_mbufn i js Ps buf"
    and "U i z"
    and "k xs z. i  k  Suc k  Mini i js 
      list_all2 (λP x. P k x) Ps xs  U k z  U (Suc k) (f xs z)"
  shows "U (Mini i js) z'"
  using assms unfolding wf_mbufn_def
proof (induction f z buf arbitrary: i z' buf' rule: mbufn_take.induct)
  case rec: (1 f z buf)
  show ?case proof (cases "buf = []")
    case True
    with rec.prems show ?thesis unfolding Mini_def by simp
  next
    case nonempty: False
    show ?thesis proof (cases "[]  set buf")
      case True
      from rec.prems(2) have "jset js. i  j"
        by (auto simp: in_set_conv_nth list_all3_conv_all_nth)
      moreover from True rec.prems(2) have "i  set js"
        by (fastforce simp: in_set_conv_nth list_all3_conv_all_nth list_all2_iff)
      ultimately have "Mini i js = i"
        unfolding Mini_def
        by (auto intro!: antisym[OF Min.coboundedI Min.boundedI])
      with rec.prems nonempty True show ?thesis by simp
    next
      case False
      with nonempty rec.prems(2) have more: "Suc i  Mini i js"
        using diff_is_0_eq not_le unfolding Mini_def
        by (fastforce simp: in_set_conv_nth list_all3_conv_all_nth list_all2_iff)
      then have "Mini i js = Mini (Suc i) js" unfolding Mini_def by auto
      show ?thesis
        unfolding ‹Mini i js = Mini (Suc i) js
      proof (rule rec.IH)
        show "¬ (buf = []  []  set buf)" using nonempty False by simp
        show "mbufn_take f (f (map hd buf) z) (map tl buf) = (z', buf')"
          using nonempty False rec.prems by simp
        show "list_all3 (λP j xs. Suc i  j  list_all2 P [Suc i..<j] xs) Ps js (map tl buf)"
          using False rec.prems
          by (auto simp: list_all3_map elim!: list_all3_mono_strong dest: list.rel_sel[THEN iffD1])
        show "U (Suc i) (f (map hd buf) z)"
          using more False rec.prems
          by (auto 0 4 simp: list_all3_map intro!: rec.prems(4) list_all3_list_all2I
              elim!: list_all3_mono_strong dest: list.rel_sel[THEN iffD1])
        show "k xs z. Suc i  k  Suc k  Mini (Suc i) js 
          list_all2 (λP. P k) Ps xs  U k z  U (Suc k) (f xs z)"
          by (rule rec.prems(4)) (auto simp: Mini_def)
      qed
    qed
  qed
qed

lemma mbufnt_take_induct[consumes 5, case_names base step]:
  assumes "mbufnt_take f z buf nts = (z', buf', nts')"
    and "wf_mbufn i js Ps buf"
    and "list_all2 R [i..<j] nts"
    and "k. k  set js  k  j"
    and "U i z"
    and "k xs t z. i  k  Suc k  Mini j js 
      list_all2 (λP x. P k x) Ps xs  R k t  U k z  U (Suc k) (f xs t z)"
  shows "U (Mini (i + length nts) js) z'"
  using assms
proof (induction f z buf nts arbitrary: i z' buf' nts' rule: mbufnt_take.induct)
  case (1 f z buf nts)
  then have *: "list_all2 R [Suc i..<j] (tl nts)"
    by (auto simp: list.rel_sel[of R "[i..<j]" nts, simplified])
  note mbufnt_take.simps[simp del]
  from 1(2-6) have "i = Min (set js)" if "js  []" "nts = []"
    using that unfolding wf_mbufn_def using wf_mbufn_in_set_Mini[OF 1(3)]
    by (fastforce simp: Mini_def list_all3_Cons neq_Nil_conv)
  with 1(2-7) list_all2_hdD[OF 1(4)] show ?case
    unfolding wf_mbufn_def using wf_mbufn_in_set_Mini[OF 1(3)] wf_mbufn_notin_set[OF 1(3)]
    by (subst (asm) mbufnt_take.simps)
      (auto simp add: Mini_def list.rel_map Suc_le_eq
        elim!: arg_cong2[of _ _ _ _ U, OF _ refl, THEN iffD1, rotated]
        list_all3_mono_strong[THEN list_all3_list_all2I[of _ _ js]] list_all2_hdD
        dest!: 1(1)[rotated, OF _ wf_mbufn_map_tl[OF 1(3)] * _ 1(7)] split: prod.split if_splits)
qed

lemma mbuf2_take_add':
  assumes eq: "mbuf2_take f (mbuf2_add xs ys buf) = (zs, buf')"
    and pre: "wf_mbuf2' σ P V j n R φ ψ buf"
    and rm: "rel_mapping (≤) P P'"
    and xs: "list_all2 (λi. qtable n (Formula.fv φ) (mem_restr R) (λv. Formula.sat σ V (map the v) i φ))
      [progress σ P φ j..<progress σ P' φ j'] xs"
    and ys: "list_all2 (λi. qtable n (Formula.fv ψ) (mem_restr R) (λv. Formula.sat σ V (map the v) i ψ))
      [progress σ P ψ j..<progress σ P' ψ j'] ys"
    and "j  j'"
  shows "wf_mbuf2' σ P' V j' n R φ ψ buf'"
    and "list_all2 (λi Z. X Y.
      qtable n (Formula.fv φ) (mem_restr R) (λv. Formula.sat σ V (map the v) i φ) X 
      qtable n (Formula.fv ψ) (mem_restr R) (λv. Formula.sat σ V (map the v) i ψ) Y 
      Z = f X Y)
      [min (progress σ P φ j) (progress σ P ψ j)..<min (progress σ P' φ j') (progress σ P' ψ j')] zs"
  using pre rm unfolding wf_mbuf2'_def
  by (force intro!: mbuf2_take_eqD[OF eq] wf_mbuf2_add[OF _ xs ys] progress_mono_gen[OF j  j' rm])+

lemma mbuf2t_take_add':
  assumes eq: "mbuf2t_take f z (mbuf2_add xs ys buf) nts = (z', buf', nts')"
    and bounded: "pred_mapping (λx. x  j) P" "pred_mapping (λx. x  j') P'"
    and rm: "rel_mapping (≤) P P'"
    and pre_buf: "wf_mbuf2' σ P V j n R φ ψ buf"
    and pre_nts: "list_all2 (λi t. t = τ σ i) [min (progress σ P φ j) (progress σ P ψ j)..<j'] nts"
    and xs: "list_all2 (λi. qtable n (Formula.fv φ) (mem_restr R) (λv. Formula.sat σ V (map the v) i φ))
      [progress σ P φ j..<progress σ P' φ j'] xs"
    and ys: "list_all2 (λi. qtable n (Formula.fv ψ) (mem_restr R) (λv. Formula.sat σ V (map the v) i ψ))
      [progress σ P ψ j..<progress σ P' ψ j'] ys"
    and "j  j'"
  shows "wf_mbuf2' σ P' V j' n R φ ψ buf'"
    and "wf_ts σ P' j' φ ψ nts'"
  using pre_buf pre_nts bounded rm unfolding wf_mbuf2'_def wf_ts_def
  by (auto intro!: mbuf2t_take_eqD[OF eq] wf_mbuf2_add[OF _ xs ys] progress_mono_gen[OF j  j' rm]
      progress_le_gen)

lemma ok_0_atms: "ok 0 mr  regex.atms (from_mregex mr []) = {}"
  by (induct mr) auto

lemma ok_0_progress: "ok 0 mr  progress_regex σ P (from_mregex mr []) j = j"
  by (drule ok_0_atms) (auto simp: progress_regex_def)

lemma atms_empty_atms: "safe_regex m g r  atms r = {}  regex.atms r = {}"
  by (induct r rule: safe_regex_induct) (auto split: if_splits simp: cases_Neg_iff)

lemma atms_empty_progress: "safe_regex m g r  atms r = {}  progress_regex σ P r j = j"
  by (drule atms_empty_atms) (auto simp: progress_regex_def)

lemma to_mregex_empty_progress: "safe_regex m g r  to_mregex r = (mr, []) 
  progress_regex σ P r j = j"
  using from_mregex_eq ok_0_progress to_mregex_ok atms_empty_atms by fastforce

lemma progress_regex_le: "pred_mapping (λx. x  j) P  progress_regex σ P r j  j"
  by (auto intro!: progress_le_gen simp: Min_le_iff progress_regex_def)

lemma Neg_acyclic: "formula.Neg x = x  P"
  by (induct x) auto

lemma case_Neg_in_iff: "x  (case y of formula.Neg φ'  {φ'} | _  {})  y = formula.Neg x"
  by (cases y) auto

lemma atms_nonempty_progress:
  "safe_regex m g r  atms r  {}  (λφ. progress σ P φ j) ` atms r = (λφ. progress σ P φ j) ` regex.atms r"
  by (frule atms_empty_atms; simp)
    (auto 0 3 simp: atms_def image_iff case_Neg_in_iff elim!: disjE_Not2 dest: safe_regex_safe_formula)

lemma to_mregex_nonempty_progress: "safe_regex m g r  to_mregex r = (mr, φs)  φs  [] 
  progress_regex σ P r j = (MIN φset φs. progress σ P φ j)"
  using atms_nonempty_progress to_mregex_ok unfolding progress_regex_def by fastforce

lemma to_mregex_progress: "safe_regex m g r  to_mregex r = (mr, φs) 
  progress_regex σ P r j = (if φs = [] then j else (MIN φset φs. progress σ P φ j))"
  using to_mregex_nonempty_progress to_mregex_empty_progress unfolding progress_regex_def by auto

lemma mbufnt_take_add':
  assumes eq: "mbufnt_take f z (mbufn_add xss buf) nts = (z', buf', nts')"
    and bounded: "pred_mapping (λx. x  j) P" "pred_mapping (λx. x  j') P'"
    and rm: "rel_mapping (≤) P P'"
    and safe: "safe_regex m g r"
    and mr: "to_mregex r = (mr, φs)"
    and pre_buf: "wf_mbufn' σ P V j n R r buf"
    and pre_nts: "list_all2 (λi t. t = τ σ i) [progress_regex σ P r j..<j'] nts"
    and xss: "list_all3 list_all2
     (map (λφ i. qtable n (fv φ) (mem_restr R) (λv. Formula.sat σ V (map the v) i φ)) φs)
     (map2 upt (map (λφ. progress σ P φ j) φs) (map (λφ. progress σ P' φ j') φs)) xss"
    and "j  j'"
  shows "wf_mbufn' σ P' V j' n R r buf'"
    and "wf_ts_regex σ P' j' r nts'"
  using pre_buf pre_nts bounded rm mr safe xss j  j'  unfolding wf_mbufn'_def wf_ts_regex_def
  using atms_empty_progress[of m g r] to_mregex_ok[OF mr]
  by (auto 0 3 simp: list.rel_map to_mregex_empty_progress to_mregex_nonempty_progress Mini_def
      intro: progress_mono_gen[OF j  j' rm] list.rel_refl_strong progress_le_gen
      dest: list_all2_lengthD elim!: mbufnt_take_eqD[OF eq wf_mbufn_add])

lemma mbuf2t_take_add_induct'[consumes 6, case_names base step]:
  assumes eq: "mbuf2t_take f z (mbuf2_add xs ys buf) nts = (z', buf', nts')"
    and bounded: "pred_mapping (λx. x  j) P" "pred_mapping (λx. x  j') P'"
    and rm: "rel_mapping (≤) P P'"
    and pre_buf: "wf_mbuf2' σ P V j n R φ ψ buf"
    and pre_nts: "list_all2 (λi t. t = τ σ i) [min (progress σ P φ j) (progress σ P ψ j)..<j'] nts"
    and xs: "list_all2 (λi. qtable n (Formula.fv φ) (mem_restr R) (λv. Formula.sat σ V (map the v) i φ))
      [progress σ P φ j..<progress σ P' φ j'] xs"
    and ys: "list_all2 (λi. qtable n (Formula.fv ψ) (mem_restr R) (λv. Formula.sat σ V (map the v) i ψ))
      [progress σ P ψ j..<progress σ P' ψ j'] ys"
    and "j  j'"
    and base: "U (min (progress σ P φ j) (progress σ P ψ j)) z"
    and step: "k X Y z. min (progress σ P φ j) (progress σ P ψ j)  k 
      Suc k  progress σ P' φ j'  Suc k  progress σ P' ψ j' 
      qtable n (Formula.fv φ) (mem_restr R) (λv. Formula.sat σ V (map the v) k φ) X 
      qtable n (Formula.fv ψ) (mem_restr R) (λv. Formula.sat σ V (map the v) k ψ) Y 
      U k z  U (Suc k) (f X Y (τ σ k) z)"
  shows "U (min (progress σ P' φ j') (progress σ P' ψ j')) z'"
  using pre_buf pre_nts bounded rm unfolding wf_mbuf2'_def
  by (blast intro!: mbuf2t_take_induct[OF eq] wf_mbuf2_add[OF _ xs ys] progress_mono_gen[OF j  j' rm]
      progress_le_gen base step)

lemma mbufnt_take_add_induct'[consumes 6, case_names base step]:
  assumes eq: "mbufnt_take f z (mbufn_add xss buf) nts = (z', buf', nts')"
    and bounded: "pred_mapping (λx. x  j) P" "pred_mapping (λx. x  j') P'"
    and rm: "rel_mapping (≤) P P'"
    and safe: "safe_regex m g r"
    and mr: "to_mregex r = (mr, φs)"
    and pre_buf: "wf_mbufn' σ P V j n R r buf"
    and pre_nts: "list_all2 (λi t. t = τ σ i) [progress_regex σ P r j..<j'] nts"
    and xss: "list_all3 list_all2
     (map (λφ i. qtable n (fv φ) (mem_restr R) (λv. Formula.sat σ V (map the v) i φ)) φs)
     (map2 upt (map (λφ. progress σ P φ j) φs) (map (λφ. progress σ P' φ j') φs)) xss"
    and "j  j'"
    and base: "U (progress_regex σ P r j) z"
    and step: "k Xs z. progress_regex σ P r j  k  Suc k  progress_regex σ P' r j' 
      list_all2 (λφ. qtable n (Formula.fv φ) (mem_restr R) (λv. Formula.sat σ V (map the v) k φ)) φs Xs 
      U k z  U (Suc k) (f Xs (τ σ k) z)"
  shows "U (progress_regex σ P' r j') z'"
  using pre_buf pre_nts bounded rm j  j' to_mregex_progress[OF safe mr, of σ P' j'] to_mregex_empty_progress[OF safe, of mr σ P j] base
  unfolding wf_mbufn'_def mr prod.case
  by (fastforce dest!: mbufnt_take_induct[OF eq wf_mbufn_add[OF _ xss] pre_nts, of U]
      simp: list.rel_map le_imp_diff_is_add ac_simps Mini_def
      intro: progress_mono_gen[OF j  j' rm] list.rel_refl_strong progress_le_gen
      intro!: base step  dest: list_all2_lengthD split: if_splits)

lemma progress_Until_le: "progress σ P (Formula.Until φ I ψ) j  min (progress σ P φ j) (progress σ P ψ j)"
  by (cases "right I") (auto simp: trans_le_add1 intro!: cInf_lower)

lemma progress_MatchF_le: "progress σ P (Formula.MatchF I r) j  progress_regex σ P r j"
  by (cases "right I") (auto simp: trans_le_add1 progress_regex_def intro!: cInf_lower)

lemma list_all2_upt_Cons: "P a x  list_all2 P [Suc a..<b] xs  Suc a  b 
  list_all2 P [a..<b] (x # xs)"
  by (simp add: list_all2_Cons2 upt_eq_Cons_conv)

lemma list_all2_upt_append: "list_all2 P [a..<b] xs  list_all2 P [b..<c] ys 
  a  b  b  c  list_all2 P [a..<c] (xs @ ys)"
  by (induction xs arbitrary: a) (auto simp add: list_all2_Cons2 upt_eq_Cons_conv)

lemma list_all3_list_all2_conv: "list_all3 R xs xs ys = list_all2 (λx. R x x) xs ys"
  by (auto simp: list_all3_conv_all_nth list_all2_conv_all_nth)

lemma map_split_map: "map_split f (map g xs) = map_split (f o g) xs"
  by (induct xs) auto

lemma map_split_alt: "map_split f xs = (map (fst o f) xs, map (snd o f) xs)"
  by (induct xs) (auto split: prod.splits)

lemma fv_formula_of_constraint: "fv (formula_of_constraint (t1, p, c, t2)) = fv_trm t1  fv_trm t2"
  by (induction "(t1, p, c, t2)" rule: formula_of_constraint.induct) simp_all

lemma (in maux) wf_mformula_wf_set: "wf_mformula σ j P V n R φ φ'  wf_set n (Formula.fv φ')"
  unfolding wf_set_def
proof (induction rule: wf_mformula.induct)
  case (AndRel P V n R φ φ' ψ' conf)
  then show ?case by (auto simp: fv_formula_of_constraint dest!: subsetD)
next
  case (Ands P V n R l l_pos l_neg l' buf A_pos A_neg)
  from Ands.IH have "φ'set (l_pos @ map remove_neg l_neg). xfv φ'. x < n"
    by (simp add: list_all2_conv_all_nth all_set_conv_all_nth[of "_ @ _"] del: set_append)
  then have "φ'set (l_pos @ l_neg). xfv φ'. x < n"
    by (auto dest: bspec[where x="remove_neg _"])
  then show ?case using Ands.hyps(2) by auto
next
  case (Agg P V b n R φ φ' y f g0 ω)
  then have "Formula.fvi_trm b f  Formula.fvi b φ'"
    by (auto simp: fvi_trm_iff_fv_trm[where b=b] fvi_iff_fv[where b=b])
  with Agg show ?case by (auto 0 3 simp: Un_absorb2 fvi_iff_fv[where b=b])
next
  case (MatchP r P V n R φs mr mrs buf nts I aux)
  then obtain φs' where conv: "to_mregex r = (mr, φs')" by blast
  with MatchP have "φ'set φs'. xfv φ'. x < n"
    by (simp add: list_all2_conv_all_nth all_set_conv_all_nth[of φs'])
  with conv show ?case
    by (simp add: to_mregex_ok[THEN conjunct1] fv_regex_alt[OF ‹safe_regex _ _ r])
next
  case (MatchF r  P V n R φs mr mrs buf nts I aux)
  then obtain φs' where conv: "to_mregex r = (mr, φs')" by blast
  with MatchF have "φ'set φs'. xfv φ'. x < n"
    by (simp add: list_all2_conv_all_nth all_set_conv_all_nth[of φs'])
  with conv show ?case
    by (simp add: to_mregex_ok[THEN conjunct1] fv_regex_alt[OF ‹safe_regex _ _ r])
qed (auto simp: fvi_Suc split: if_splits)

lemma qtable_mmulti_join:
  assumes pos: "list_all3 (λA Qi X. qtable n A P Qi X  wf_set n A) A_pos Q_pos L_pos"
    and neg: "list_all3 (λA Qi X. qtable n A P Qi X  wf_set n A) A_neg Q_neg L_neg"
    and C_eq: "C = (set A_pos)" and L_eq: "L = L_pos @ L_neg"
    and "A_pos  []" and fv_subset: "(set A_neg)  (set A_pos)"
    and restrict_pos: "x. wf_tuple n C x  P x  list_all (λA. P (restrict A x)) A_pos"
    and restrict_neg: "x. wf_tuple n C x  P x  list_all (λA. P (restrict A x)) A_neg"
    and Qs: "x. wf_tuple n C x  P x  Q x 
      list_all2 (λA Qi. Qi (restrict A x)) A_pos Q_pos 
      list_all2 (λA Qi. ¬ Qi (restrict A x)) A_neg Q_neg"
  shows "qtable n C P Q (mmulti_join n A_pos A_neg L)"
proof (rule qtableI)
  from pos have 1: "list_all2 (λA X. table n A X  wf_set n A) A_pos L_pos"
    by (simp add: list_all3_conv_all_nth list_all2_conv_all_nth qtable_def)
  moreover from neg have "list_all2 (λA X. table n A X  wf_set n A) A_neg L_neg"
    by (simp add: list_all3_conv_all_nth list_all2_conv_all_nth qtable_def)
  ultimately have L: "list_all2 (λA X. table n A X  wf_set n A) (A_pos @ A_neg) (L_pos @ L_neg)"
    by (rule list_all2_appendI)
  note in_join_iff = mmulti_join_correct[OF A_pos  [] L]
  from 1 have take_eq: "take (length A_pos) (L_pos @ L_neg) = L_pos"
    by (auto dest!: list_all2_lengthD)
  from 1 have drop_eq: "drop (length A_pos) (L_pos @ L_neg) = L_neg"
    by (auto dest!: list_all2_lengthD)

  note mmulti_join.simps[simp del]
  show "table n C (mmulti_join n A_pos A_neg L)"
    unfolding C_eq L_eq table_def by (simp add: in_join_iff)
  show "Q x" if "x  mmulti_join n A_pos A_neg L" "wf_tuple n C x" "P x" for x
    using that(2,3)
  proof (rule Qs[THEN iffD2, OF _ _ conjI])
    have pos': "list_all2 (λA. (∈) (restrict A x)) A_pos L_pos"
      and neg': "list_all2 (λA. (∉) (restrict A x)) A_neg L_neg"
      using that(1) unfolding L_eq in_join_iff take_eq drop_eq by simp_all
    show "list_all2 (λA Qi. Qi (restrict A x)) A_pos Q_pos"
      using pos pos' restrict_pos that(2,3)
      by (simp add: list_all3_conv_all_nth list_all2_conv_all_nth list_all_length qtable_def)
    have fv_subset': "i. i < length A_neg  A_neg ! i  C"
      using fv_subset unfolding C_eq by (auto simp: Sup_le_iff)
    show "list_all2 (λA Qi. ¬ Qi (restrict A x)) A_neg Q_neg"
      using neg neg' restrict_neg that(2,3)
      by (auto simp: list_all3_conv_all_nth list_all2_conv_all_nth list_all_length qtable_def
          wf_tuple_restrict_simple[OF _ fv_subset'])
  qed
  show "x  mmulti_join n A_pos A_neg L" if "wf_tuple n C x" "P x" "Q x" for x
    unfolding L_eq in_join_iff take_eq drop_eq
  proof (intro conjI)
    from that have pos': "list_all2 (λA Qi. Qi (restrict A x)) A_pos Q_pos"
      and neg': "list_all2 (λA Qi. ¬ Qi (restrict A x)) A_neg Q_neg"
      using Qs[THEN iffD1] by auto
    show "wf_tuple n (Aset A_pos. A) x"
      using ‹wf_tuple n C x unfolding C_eq by simp
    show "list_all2 (λA. (∈) (restrict A x)) A_pos L_pos"
      using pos pos' restrict_pos that(1,2)
      by (simp add: list_all3_conv_all_nth list_all2_conv_all_nth list_all_length qtable_def
          C_eq wf_tuple_restrict_simple[OF _ Sup_upper])
    show "list_all2 (λA. (∉) (restrict A x)) A_neg L_neg"
      using neg neg' restrict_neg that(1,2)
      by (auto simp: list_all3_conv_all_nth list_all2_conv_all_nth list_all_length qtable_def)
  qed
qed

lemma nth_filter: "i < length (filter P xs) 
  (i'. i' < length xs  P (xs ! i')  Q (xs ! i'))  Q (filter P xs ! i)"
  by (metis (lifting) in_set_conv_nth set_filter mem_Collect_eq)

lemma nth_partition: "i < length xs 
  (i'. i' < length (filter P xs)  Q (filter P xs ! i')) 
  (i'. i' < length (filter (Not  P) xs)  Q (filter (Not  P) xs ! i'))  Q (xs ! i)"
  by (metis (no_types, lifting) in_set_conv_nth set_filter mem_Collect_eq comp_apply)

lemma qtable_bin_join:
  assumes "qtable n A P Q1 X" "qtable n B P Q2 Y" "¬ b  B  A" "C = A  B"
    "x. wf_tuple n C x  P x  P (restrict A x)  P (restrict B x)"
    "x. b  wf_tuple n C x  P x  Q x  Q1 (restrict A x)  Q2 (restrict B x)"
    "x. ¬ b  wf_tuple n C x  P x  Q x  Q1 (restrict A x)  ¬ Q2 (restrict B x)"
  shows "qtable n C P Q (bin_join n A X b B Y)"
  using qtable_join[OF assms] bin_join_table[of n A X B Y b] assms(1,2)
  by (auto simp add: qtable_def)

lemma restrict_update: "y  A  y < length x  restrict A (x[y:=z]) = restrict A x"
  unfolding restrict_def by (auto simp add: nth_list_update)

lemma qtable_assign:
  assumes "qtable n A P Q X"
    "y < n" "insert y A = A'" "y  A"
    "x'. wf_tuple n A' x'  P x'  P (restrict A x')"
    "x. wf_tuple n A x  P x  Q x  Q' (x[y:=Some (f x)])"
    "x'. wf_tuple n A' x'  P x'  Q' x'  Q (restrict A x')  x' ! y = Some (f (restrict A x'))"
  shows "qtable n A' P Q' ((λx. x[y:=Some (f x)]) ` X)" (is "qtable _ _ _ _ ?Y")
proof (rule qtableI)
  from assms(1) have "table n A X" unfolding qtable_def by simp
  then show "table n A' ?Y"
    unfolding table_def wf_tuple_def using assms(2,3)
    by (auto simp: nth_list_update)
next
  fix x'
  assume "x'  ?Y" "wf_tuple n A' x'" "P x'"
  then obtain x where "x  X" and x'_eq: "x' = x[y:=Some (f x)]" by blast
  then have "wf_tuple n A x"
    using assms(1) unfolding qtable_def table_def by blast
  then have "y < length x" using assms(2) by (simp add: wf_tuple_def)
  with ‹wf_tuple n A x have "restrict A x' = x"
    unfolding x'_eq by (simp add: restrict_update[OF assms(4)] restrict_idle)
  with ‹wf_tuple n A' x' P x' have "P x"
    using assms(5) by blast
  with ‹wf_tuple n A x x  X have "Q x"
    using assms(1) by (elim in_qtableE)
  with ‹wf_tuple n A x P x show "Q' x'"
    unfolding x'_eq by (rule assms(6))
next
  fix x'
  assume "wf_tuple n A' x'" "P x'" "Q' x'"
  then have "wf_tuple n A (restrict A x')"
    using assms(3) by (auto intro!: wf_tuple_restrict_simple)
  moreover have "P (restrict A x')"
    using ‹wf_tuple n A' x' P x' by (rule assms(5))
  moreover have "Q (restrict A x')" and y: "x' ! y = Some (f (restrict A x'))"
    using ‹wf_tuple n A' x' P x' Q' x' by (auto dest!: assms(7))
  ultimately have "restrict A x'  X" by (intro in_qtableI[OF assms(1)])
  moreover have "x' = (restrict A x')[y:=Some (f (restrict A x'))]"
    using y assms(2,3) ‹wf_tuple n A (restrict A x') ‹wf_tuple n A' x'
    by (auto simp: list_eq_iff_nth_eq wf_tuple_def nth_list_update nth_restrict)
  ultimately show "x'  ?Y" by simp
qed

lemma sat_the_update: "y  fv φ  Formula.sat σ V (map the (x[y:=z])) i φ = Formula.sat σ V (map the x) i φ"
  by (rule sat_fv_cong) (metis map_update nth_list_update_neq)

lemma progress_constraint: "progress σ P (formula_of_constraint c) j = j"
  by (induction rule: formula_of_constraint.induct) simp_all

lemma qtable_filter:
  assumes "qtable n A P Q X"
    "x. wf_tuple n A x  P x  Q x  R x  Q' x"
  shows "qtable n A P Q' (Set.filter R X)" (is "qtable _ _ _ _ ?Y")
proof (rule qtableI)
  from assms(1) have "table n A X"
    unfolding qtable_def by simp
  then show "table n A ?Y"
    unfolding table_def wf_tuple_def by simp
next
  fix x
  assume "x  ?Y" "wf_tuple n A x" "P x"
  with assms show "Q' x" by (auto elim!: in_qtableE)
next
  fix x
  assume "wf_tuple n A x" "P x" "Q' x"
  with assms show "x  Set.filter R X" by (auto intro!: in_qtableI)
qed

lemma eval_constraint_sat_eq: "wf_tuple n A x  fv_trm t1  A  fv_trm t2  A 
  iA. i < n  eval_constraint (t1, p, c, t2) x =
    Formula.sat σ V (map the x) i (formula_of_constraint (t1, p, c, t2))"
  by (induction "(t1, p, c, t2)" rule: formula_of_constraint.induct)
    (simp_all add: meval_trm_eval_trm)

declare progress_le_gen[simp]

definition "wf_envs σ j P P' V db =
  (dom V = dom P 
   Mapping.keys db = dom P  {p. p  fst ` Γ σ j} 
   rel_mapping (≤) P P' 
   pred_mapping (λi. i  j) P 
   pred_mapping (λi. i  Suc j) P' 
   (p  Mapping.keys db - dom P. the (Mapping.lookup db p) = [{ts. (p, ts)  Γ σ j}]) 
   (p  dom P. list_all2 (λi X. X = the (V p) i) [the (P p)..<the (P' p)] (the (Mapping.lookup db p))))"


lift_definition mk_db :: "(Formula.name × event_data list) set  Formula.database" is
  "λX p. (if p  fst ` X then Some [{ts. (p, ts)  X}] else None)" .

lemma wf_envs_mk_db: "wf_envs σ j Map.empty Map.empty Map.empty (mk_db (Γ σ j))"
  unfolding wf_envs_def mk_db_def
  by transfer (force split: if_splits simp: image_iff rel_mapping_alt)

lemma wf_envs_update:
  assumes wf_envs: "wf_envs σ j P P' V db"
    and m_eq: "m = Formula.nfv φ"
    and in_fv: "{0 ..< m}  fv φ"
    and xs: "list_all2 (λi. qtable m (Formula.fv φ) (mem_restr UNIV) (λv. Formula.sat σ V (map the v) i φ))
      [progress σ P φ j..<progress σ P' φ (Suc j)] xs"
  shows "wf_envs σ j (P(p  progress σ P φ j)) (P'(p  progress σ P' φ (Suc j)))
    (V(p  λi. {v. length v = m  Formula.sat σ V v i φ}))
    (Mapping.update p (map (image (map the)) xs) db)"
  unfolding wf_envs_def
proof (intro conjI ballI, goal_cases)
  case 3
  from assms show ?case
    by (auto simp: wf_envs_def pred_mapping_alt progress_le progress_mono_gen
        intro!: rel_mapping_map_upd)
next
  case (6 p')
  with assms show ?case by (cases "p'  dom P") (auto simp: wf_envs_def lookup_update')
next
  case (7 p')
  from xs in_fv have "list_all2 (λx y. map the ` y = {v. length v = m  Formula.sat σ V v x φ})
      [progress σ P φ j..<progress σ P' φ (Suc j)] xs"
    by (elim list.rel_mono_strong) (auto 0 3 simp: wf_tuple_def nth_append
      elim!: in_qtableE in_qtableI intro!: image_eqI[where x="map Some _"])
  moreover have "list_all2 (λi X. X = the (V p') i) [the (P p')..<the (P' p')] (the (Mapping.lookup db p'))"
    if "p  p'"
  proof -
    from that 7 have "p'  dom P" by simp
    with wf_envs show ?thesis by (simp add: wf_envs_def)
  qed
  ultimately show ?case
    by (simp add: list.rel_map image_iff lookup_update')
qed (use assms in auto simp: wf_envs_def›)

lemma wf_envs_P_simps[simp]:
   "wf_envs σ j P P' V db  pred_mapping (λi. i  j) P"
   "wf_envs σ j P P' V db  pred_mapping (λi. i  Suc j) P'"
   "wf_envs σ j P P' V db  rel_mapping (≤) P P'"
  unfolding wf_envs_def by auto

lemma wf_envs_progress_le[simp]:
   "wf_envs σ j P P' V db  progress σ P φ j  j"
   "wf_envs σ j P P' V db  progress σ P' φ (Suc j)  Suc j"
  unfolding wf_envs_def by auto

lemma wf_envs_progress_regex_le[simp]:
   "wf_envs σ j P P' V db  progress_regex σ P r j  j"
   "wf_envs σ j P P' V db  progress_regex σ P' r (Suc j)  Suc j"
  unfolding wf_envs_def by (auto simp: progress_regex_le)

lemma wf_envs_progress_mono[simp]:
   "wf_envs σ j P P' V db  a  b  progress σ P φ a  progress σ P' φ b"
  unfolding wf_envs_def
  by (auto simp: progress_mono_gen)

lemma qtable_wf_tuple_cong: "qtable n A P Q X  A = B  (v. wf_tuple n A v  P v  Q v = Q' v)  qtable n B P Q' X"
  unfolding qtable_def table_def by blast

lemma (in maux) meval:
  assumes "wf_mformula σ j P V n R φ φ'" "wf_envs σ j P P' V db"
  shows "case meval n (τ σ j) db φ of (xs, φn)  wf_mformula σ (Suc j) P' V n R φn φ' 
    list_all2 (λi. qtable n (Formula.fv φ') (mem_restr R) (λv. Formula.sat σ V (map the v) i φ'))
    [progress σ P φ' j..<progress σ P' φ' (Suc j)] xs"
  using assms
proof (induction φ arbitrary: db P P' V n R φ')
  case (MRel rel)
  then show ?case
    by (cases rule: wf_mformula.cases)
      (auto simp add: ball_Un intro: wf_mformula.intros table_eq_rel eq_rel_eval_trm
        in_eq_rel qtable_empty qtable_unit_table intro!: qtableI)
next
  case (MPred e ts)
  then show ?case
  proof (cases "e  dom P")
    case True
    with MPred(2) have "e  Mapping.keys db" "e  dom P'" "e  dom V"
      "list_all2 (λi X. X = the (V e) i) [the (P e)..<the (P' e)]
         (the (Mapping.lookup db e))" unfolding wf_envs_def rel_mapping_alt by blast+
    with MPred(1) True show ?thesis
      by (cases rule: wf_mformula.cases)
        (fastforce intro!: wf_mformula.Pred qtableI bexI[where P="λx. _ = tabulate x 0 n", OF refl]
        elim!: list.rel_mono_strong bexI[rotated] dest: ex_match
        simp: list.rel_map table_def match_wf_tuple in_these_eq match_eval_trm image_iff
          list.map_comp keys_dom_lookup)
  next
    note MPred(1)
    moreover
    case False
    moreover
    from False MPred(2) have "e  dom P'" "e  dom V"
      unfolding wf_envs_def rel_mapping_alt by auto
    moreover
    from False MPred(2) have *: "e  fst ` Γ σ j  e  Mapping.keys db"
      unfolding wf_envs_def by auto
    from False MPred(2) have
      "e  Mapping.keys db  Mapping.lookup db e = Some [{ts. (e, ts)  Γ σ j}]"
      unfolding wf_envs_def keys_dom_lookup by (metis Diff_iff domD option.sel)
    with * have "(case Mapping.lookup db e of None  [{}] | Some xs  xs) = [{ts. (e, ts)  Γ σ j}]"
      by (cases "e  fst ` Γ σ j") (auto simp: image_iff keys_dom_lookup split: option.splits)
    ultimately show ?thesis
      by (cases rule: wf_mformula.cases)
        (fastforce intro!: wf_mformula.Pred qtableI bexI[where P="λx. _ = tabulate x 0 n", OF refl]
        elim!: list.rel_mono_strong bexI[rotated] dest: ex_match
        simp: list.rel_map table_def match_wf_tuple in_these_eq match_eval_trm image_iff list.map_comp)
  qed
next
  case (MLet p m φ1 φ2)
  from MLet.prems(1) obtain φ1' φ2' where Let: "φ' = Formula.Let p φ1' φ2'" and
    1: "wf_mformula σ j P V m UNIV φ1 φ1'" and
    fv: "m = Formula.nfv φ1'" "{0..<m}  fv φ1'" and
    2: "wf_mformula σ j (P(p  progress σ P φ1' j))
      (V(p  λi. {v. length v = m  Formula.sat σ V v i φ1'}))
      n R φ2 φ2'"
    by (cases rule: wf_mformula.cases) auto
  obtain xs φ1_new where e1: "meval m (τ σ j) db φ1 = (xs, φ1_new)" and
      wf1: "wf_mformula σ (Suc j) P' V m UNIV φ1_new φ1'" and
      res1: "list_all2 (λi. qtable m (fv φ1') (mem_restr UNIV) (λv. Formula.sat σ V (map the v) i φ1'))
       [progress σ P φ1' j..<progress σ P' φ1' (Suc j)] xs"
    using MLet(1)[OF 1(1) MLet.prems(2)] by (auto simp: eqTrueI[OF mem_restr_UNIV, abs_def])
  from MLet(2)[OF 2 wf_envs_update[OF MLet.prems(2) fv res1]] wf1 e1 fv
  show ?case unfolding Let
    by (auto simp: fun_upd_def intro!: wf_mformula.Let)
next
  case (MAnd A_φ φ pos A_ψ ψ buf)
  from MAnd.prems show ?case
    by (cases rule: wf_mformula.cases)
      (auto simp: sat_the_restrict simp del: bin_join.simps
        dest!: MAnd.IH split: if_splits prod.splits intro!: wf_mformula.And qtable_bin_join
        elim: mbuf2_take_add'(1) list.rel_mono_strong[OF mbuf2_take_add'(2)])
next
  case (MAndAssign φ conf)
  from MAndAssign.prems obtain φ'' x t ψ'' where
    wf_envs: "wf_envs σ j P P' V db" and
    φ'_eq: "φ' = formula.And φ'' ψ''" and
    wf_φ: "wf_mformula σ j P V n R φ φ''" and
    "x < n" and
    "x  fv φ''" and
    fv_t_subset: "fv_trm t  fv φ''" and
    conf: "(x, t) = conf" and
    ψ''_eqs: "ψ'' = formula.Eq (trm.Var x) t  ψ'' = formula.Eq t (trm.Var x)"
    by (cases rule: wf_mformula.cases)
  from wf_φ wf_envs obtain xs φn where
    meval_eq: "meval n (τ σ j) db φ = (xs, φn)" and
    wf_φn: "wf_mformula σ (Suc j) P' V n R φn φ''" and
    xs: "list_all2 (λi. qtable n (fv φ'') (mem_restr R) (λv. Formula.sat σ V (map the v) i φ''))
        [progress σ P φ'' j..<progress σ P' φ'' (Suc j)] xs"
    by (auto dest!: MAndAssign.IH)
  have progress_eqs:
      "progress σ P φ' j = progress σ P φ'' j"
      "progress σ P' φ' (Suc j) = progress σ P' φ'' (Suc j)"
    using ψ''_eqs wf_envs_progress_le[OF wf_envs] by (auto simp: φ'_eq)

  show ?case proof (simp add: meval_eq, intro conjI)
    show "wf_mformula σ (Suc j) P' V n R (MAndAssign φn conf) φ'"
      unfolding φ'_eq
      by (rule wf_mformula.AndAssign) fact+
  next
    show "list_all2 (λi. qtable n (fv φ') (mem_restr R) (λv. Formula.sat σ V (map the v) i φ'))
        [progress σ P φ' j..<progress σ P' φ' (Suc j)] (map ((`) (eval_assignment conf)) xs)"
      unfolding list.rel_map progress_eqs conf[symmetric] eval_assignment.simps
      using xs
    proof (rule list.rel_mono_strong)
      fix i X
      assume qtable: "qtable n (fv φ'') (mem_restr R) (λv. Formula.sat σ V (map the v) i φ'') X"
      then show "qtable n (fv φ') (mem_restr R) (λv. Formula.sat σ V (map the v) i φ')
          ((λy. y[x := Some (meval_trm t y)]) ` X)"
      proof (rule qtable_assign)
        show "x < n" by fact
        show "insert x (fv φ'') = fv φ'"
          using ψ''_eqs fv_t_subset by (auto simp: φ'_eq)
        show "x  fv φ''" by fact
      next
        fix v
        assume wf_v: "wf_tuple n (fv φ') v" and "mem_restr R v"
        then show "mem_restr R (restrict (fv φ'') v)" by simp

        assume sat: "Formula.sat σ V (map the v) i φ'"
        then have A: "Formula.sat σ V (map the (restrict (fv φ'') v)) i φ''" (is ?A)
          by (simp add: φ'_eq sat_the_restrict)
        have "map the v ! x = Formula.eval_trm (map the v) t"
          using sat ψ''_eqs by (auto simp: φ'_eq)
        also have "... = Formula.eval_trm (map the (restrict (fv φ'') v)) t"
          using fv_t_subset by (auto simp: map_the_restrict intro!: eval_trm_fv_cong)
        finally have "map the v ! x = meval_trm t (restrict (fv φ'') v)"
          using meval_trm_eval_trm[of n "fv φ''" "restrict (fv φ'') v" t]
            fv_t_subset wf_v wf_mformula_wf_set[unfolded wf_set_def, OF wf_φ]
          by (fastforce simp: φ'_eq intro!: wf_tuple_restrict)
        then have B: "v ! x = Some (meval_trm t (restrict (fv φ'') v))" (is ?B)
          using ψ''_eqs wf_v x < n by (auto simp: wf_tuple_def φ'_eq)
        from A B show "?A  ?B" ..
      next
        fix v
        assume wf_v: "wf_tuple n (fv φ'') v" and "mem_restr R v"
          and sat: "Formula.sat σ V (map the v) i φ''"
        let ?v = "v[x := Some (meval_trm t v)]"
        from sat have A: "Formula.sat σ V (map the ?v) i φ''"
          using x  fv φ'' by (simp add: sat_the_update)
        have "y  fv_trm t  x  y" for y
          using fv_t_subset x  fv φ'' by auto
        then have B: "Formula.sat σ V (map the ?v) i ψ''"
          using ψ''_eqs meval_trm_eval_trm[of n "fv φ''" v t] x < n
            fv_t_subset wf_v wf_mformula_wf_set[unfolded wf_set_def, OF wf_φ]
          by (auto simp: wf_tuple_def map_update intro!: eval_trm_fv_cong)
        from A B show "Formula.sat σ V (map the ?v) i φ'"
          by (simp add: φ'_eq)
      qed
    qed
  qed
next
  case (MAndRel φ conf)
  from MAndRel.prems show ?case
    by (cases rule: wf_mformula.cases)
      (auto simp: progress_constraint progress_le list.rel_map fv_formula_of_constraint
        Un_absorb2 wf_mformula_wf_set[unfolded wf_set_def] split: prod.splits
        dest!: MAndRel.IH[where db=db and P=P and P'=P'] eval_constraint_sat_eq[THEN iffD2]
        intro!: wf_mformula.AndRel
        elim!: list.rel_mono_strong qtable_filter eval_constraint_sat_eq[THEN iffD1])
next
  case (MAnds A_pos A_neg l buf)
  note mbufn_take.simps[simp del] mbufn_add.simps[simp del] mmulti_join.simps[simp del]

  from MAnds.prems obtain pos neg l' where
    wf_l: "list_all2 (wf_mformula σ j P V n R) l (pos @ map remove_neg neg)" and
    wf_buf: "wf_mbufn (progress σ P (formula.Ands l') j) (map (λψ. progress σ P ψ j) (pos @ map remove_neg neg))
      (map (λψ i. qtable n (fv ψ) (mem_restr R) (λv. Formula.sat σ V (map the v) i ψ)) (pos @ map remove_neg neg)) buf" and
    posneg: "(pos, neg) = partition safe_formula l'" and
    "pos  []" and
    safe_neg: "list_all safe_formula (map remove_neg neg)" and
    A_eq: "A_pos = map fv pos" "A_neg = map fv neg" and
    fv_subset: " (set A_neg)   (set A_pos)" and
    "φ' = Formula.Ands l'"
    by (cases rule: wf_mformula.cases) simp
  have progress_eq: "progress σ P' (formula.Ands l') (Suc j) =
      Mini (progress σ P (formula.Ands l') j) (map (λψ. progress σ P' ψ (Suc j)) (pos @ map remove_neg neg))"
    using pos  [] posneg
    by (auto simp: Mini_def image_Un[symmetric] Collect_disj_eq[symmetric] intro!: arg_cong[where f=Min])

  have join_ok: "qtable n ( (fv ` set l')) (mem_restr R)
        (λv. list_all (Formula.sat σ V (map the v) k) l')
        (mmulti_join n A_pos A_neg L)"
    if args_ok: "list_all2 (λx. qtable n (fv x) (mem_restr R) (λv. Formula.sat σ V (map the v) k x))
        (pos @ map remove_neg neg) L"
    for k L
  proof (rule qtable_mmulti_join)
    let ?ok = "λA Qi X. qtable n A (mem_restr R) Qi X  wf_set n A"
    let ?L_pos = "take (length A_pos) L"
    let ?L_neg = "drop (length A_pos) L"
    have 1: "length pos  length L"
      using args_ok by (auto dest!: list_all2_lengthD)
    show "list_all3 ?ok A_pos (map (λψ v. Formula.sat σ V (map the v) k ψ) pos) ?L_pos"
      using args_ok wf_l unfolding A_eq
      by (auto simp add: list_all3_conv_all_nth list_all2_conv_all_nth nth_append
          split: if_splits intro!: wf_mformula_wf_set[of σ j P V n R]
          dest: order.strict_trans2[OF _ 1])
    from args_ok have prems_neg: "list_all2 (λψ. qtable n (fv ψ) (mem_restr R) (λv. Formula.sat σ V (map the v) k (remove_neg ψ))) neg ?L_neg"
      by (auto simp: A_eq list_all2_append1 list.rel_map)
    show "list_all3 ?ok A_neg (map (λψ v. Formula.sat σ V (map the v) k (remove_neg ψ)) neg) ?L_neg"
      using prems_neg wf_l unfolding A_eq
      by (auto simp add: list_all3_conv_all_nth list_all2_conv_all_nth list_all_length nth_append less_diff_conv
          split: if_splits intro!: wf_mformula_wf_set[of σ j P V n R _ "remove_neg _", simplified])
    show "(fv ` set l') = (set A_pos)"
      using fv_subset posneg unfolding A_eq by auto
    show "L = take (length A_pos) L @ drop (length A_pos) L" by simp
    show "A_pos  []" using pos  [] A_eq by simp

    fix x :: "event_data tuple"
    assume "wf_tuple n ( (fv ` set l')) x" and "mem_restr R x"
    then show "list_all (λA. mem_restr R (restrict A x)) A_pos"
      and "list_all (λA. mem_restr R (restrict A x)) A_neg"
      by (simp_all add: list.pred_set)

    have "list_all Formula.is_Neg neg"
      using posneg safe_neg
      by (auto 0 3 simp add: list.pred_map elim!: list.pred_mono_strong
          intro: formula.exhaust[of ψ "Formula.is_Neg ψ" for ψ])
    then have "list_all (λψ. Formula.sat σ V (map the v) i (remove_neg ψ) 
      ¬ Formula.sat σ V (map the v) i ψ) neg" for v i
      by (fastforce simp: Formula.is_Neg_def elim!: list.pred_mono_strong)
    then show "list_all (Formula.sat σ V (map the x) k) l' =
       (list_all2 (λA Qi. Qi (restrict A x)) A_pos
         (map (λψ v. Formula.sat σ V (map the v) k ψ) pos) 
        list_all2 (λA Qi. ¬ Qi (restrict A x)) A_neg
         (map (λψ v. Formula.sat σ V (map the v) k
                       (remove_neg ψ))
           neg))"
      using posneg
      by (auto simp add: A_eq list_all2_conv_all_nth list_all_length sat_the_restrict
          elim: nth_filter nth_partition[where P=safe_formula and Q="Formula.sat _ _ _ _"])
  qed fact

  from MAnds.prems(2) show ?case
    unfolding φ' = Formula.Ands l'
    by (auto 0 3 simp add: list.rel_map progress_eq map2_map_map list_all3_map
        list_all3_list_all2_conv list.pred_map
        simp del: set_append map_append progress_simps split: prod.splits
        intro!: wf_mformula.Ands[OF _ _ posneg pos  [] safe_neg A_eq fv_subset]
        list.rel_mono_strong[OF wf_l] wf_mbufn_add[OF wf_buf]
        list.rel_flip[THEN iffD1, OF list.rel_mono_strong, OF wf_l]
        list.rel_refl join_ok[unfolded list.pred_set]
        dest!: MAnds.IH[OF _ _ MAnds.prems(2), rotated]
        elim!: wf_mbufn_take list_all2_appendI
        elim: mbufn_take_induct[OF _ wf_mbufn_add[OF wf_buf]])
next
  case (MOr φ ψ buf)
  from MOr.prems show ?case
    by (cases rule: wf_mformula.cases)
      (auto dest!: MOr.IH split: if_splits prod.splits intro!: wf_mformula.Or qtable_union
        elim: mbuf2_take_add'(1) list.rel_mono_strong[OF mbuf2_take_add'(2)])
next
  case (MNeg φ)
  have *: "qtable n {} (mem_restr R) (λv. P v) X 
    ¬ qtable n {} (mem_restr R) (λv. ¬ P v) empty_table  x  X  False" for P x X
    using nullary_qtable_cases qtable_unit_empty_table by fastforce
  from MNeg.prems show ?case
    by (cases rule: wf_mformula.cases)
      (auto 0 4 intro!: wf_mformula.Neg dest!: MNeg.IH
        simp add: list.rel_map
        dest: nullary_qtable_cases qtable_unit_empty_table intro!: qtable_empty_unit_table
        elim!: list.rel_mono_strong elim: *)
next
  case (MExists φ)
  from MExists.prems show ?case
    by (cases rule: wf_mformula.cases)
      (force simp: list.rel_map fvi_Suc sat_fv_cong nth_Cons'
        intro!: wf_mformula.Exists dest!: MExists.IH qtable_project_fv
        elim!: list.rel_mono_strong table_fvi_tl qtable_cong sat_fv_cong[THEN iffD1, rotated -1]
        split: if_splits)+
next
  case (MAgg g0 y ω b f φ)
  from MAgg.prems show ?case
    using wf_mformula_wf_set[OF MAgg.prems(1), unfolded wf_set_def]
    by (cases rule: wf_mformula.cases)
      (auto 0 3 simp add: list.rel_map simp del: sat.simps fvi.simps split: prod.split
        intro!: wf_mformula.Agg qtable_eval_agg dest!: MAgg.IH elim!: list.rel_mono_strong)
next
  case (MPrev I φ first buf nts)
  from MPrev.prems show ?case
  proof (cases rule: wf_mformula.cases)
    case (Prev ψ)
    let ?xs = "fst (meval n (τ σ j) db φ)"
    let  = "snd (meval n (τ σ j) db φ)"
    let ?ls = "fst (mprev_next I (buf @ ?xs) (nts @ [τ σ j]))"
    let ?rs = "fst (snd (mprev_next I (buf @ ?xs) (nts @ [τ σ j])))"
    let ?ts = "snd (snd (mprev_next I (buf @ ?xs) (nts @ [τ σ j])))"
    let ?P = "λi X. qtable n (fv ψ) (mem_restr R) (λv. Formula.sat σ V (map the v) i ψ) X"
    let ?min = "min (progress σ P' ψ (Suc j)) (Suc j - 1)"
    from Prev MPrev.IH[OF _ MPrev.prems(2), of n R ψ] have IH: "wf_mformula σ (Suc j) P' V n R  ψ" and
      "list_all2 ?P [progress σ P ψ j..<progress σ P' ψ (Suc j)] ?xs" by auto
    with Prev(4,5) MPrev.prems(2) have "list_all2 (λi X. if mem (τ σ (Suc i) - τ σ i) I then ?P i X else X = empty_table)
        [min (progress σ P ψ j) (j - 1)..<?min] ?ls 
       list_all2 ?P [?min..<progress σ P' ψ (Suc j)] ?rs 
       list_all2 (λi t. t = τ σ i) [?min..<Suc j] ?ts"
      by (intro mprev) (auto intro!: list_all2_upt_append list_all2_appendI order.trans[OF min.cobounded1])
    moreover have "min (Suc (progress σ P ψ j)) j = Suc (min (progress σ P ψ j) (j-1))" if "j > 0"
      using that by auto
    ultimately show ?thesis using Prev(1,3) MPrev.prems(2) IH
      by (auto simp: map_Suc_upt[symmetric] upt_Suc[of 0] list.rel_map qtable_empty_iff
          simp del: upt_Suc elim!: wf_mformula.Prev list.rel_mono_strong
          split: prod.split if_split_asm)
  qed
next
  case (MNext I φ first nts)
  from MNext.prems show ?case
  proof (cases rule: wf_mformula.cases)
    case (Next ψ)

    have min[simp]:
      "min (progress σ P ψ j - Suc 0) (j - Suc 0) = progress σ P ψ j - Suc 0"
      "min (progress σ P' ψ (Suc j) - Suc 0) j = progress σ P' ψ (Suc j) - Suc 0"
      using wf_envs_progress_le[OF MNext.prems(2), of ψ] by auto

    let ?xs = "fst (meval n (τ σ j) db φ)"
    let ?ys = "case (?xs, first) of (_ # xs, True)  xs | _  ?xs"
    let  = "snd (meval n (τ σ j) db φ)"
    let ?ls = "fst (mprev_next I ?ys (nts @ [τ σ j]))"
    let ?rs = "fst (snd (mprev_next I ?ys (nts @ [τ σ j])))"
    let ?ts = "snd (snd (mprev_next I ?ys (nts @ [τ σ j])))"
    let ?P = "λi X. qtable n (fv ψ) (mem_restr R) (λv. Formula.sat σ V (map the v) i ψ) X"
    let ?min = "min (progress σ P' ψ (Suc j) - 1) (Suc j - 1)"
    from Next MNext.IH[OF _ MNext.prems(2), of n R ψ] have IH: "wf_mformula σ (Suc j) P' V  n R  ψ"
      "list_all2 ?P [progress σ P ψ j..<progress σ P' ψ (Suc j)] ?xs" by auto
    with Next have "list_all2 (λi X. if mem (τ σ (Suc i) - τ σ i) I then ?P (Suc i) X else X = empty_table)
        [progress σ P ψ j - 1..<?min] ?ls 
       list_all2 ?P [Suc ?min..<progress σ P' ψ (Suc j)] ?rs 
       list_all2 (λi t. t = τ σ i) [?min..<Suc j] ?ts" if "progress σ P ψ j < progress σ P' ψ (Suc j)"
      using that wf_envs_progress_le[OF MNext.prems(2), of ψ]
      by (intro mnext) (auto simp: list_all2_Cons2 upt_eq_Cons_conv
          intro!: list_all2_upt_append list_all2_appendI split: list.splits)
    then show ?thesis using wf_envs_progress_le[OF MNext.prems(2), of ψ]
      wf_envs_progress_mono[OF MNext.prems(2), of j "Suc j" ψ, simplified] Next IH
      by (cases "progress σ P' ψ (Suc j) > progress σ P ψ j")
        (auto 0 3 simp: qtable_empty_iff le_Suc_eq le_diff_conv
          elim!: wf_mformula.Next list.rel_mono_strong list_all2_appendI
          split: prod.split list.splits if_split_asm)  (* slow 5 sec*)
  qed
next
  case (MSince args φ ψ buf nts aux)
  note sat.simps[simp del]
  from MSince.prems obtain φ'' φ''' ψ'' I where Since_eq: "φ' = Formula.Since φ''' I ψ''"
    and pos: "if args_pos args then φ''' = φ'' else φ''' = Formula.Neg φ''"
    and pos_eq: "safe_formula φ''' = args_pos args"
    and φ: "wf_mformula σ j P V n R φ φ''"
    and ψ: "wf_mformula σ j P V n R ψ ψ''"
    and fvi_subset: "Formula.fv φ''  Formula.fv ψ''"
    and buf: "wf_mbuf2' σ P V j n R φ'' ψ'' buf"
    and nts: "wf_ts σ P j φ'' ψ'' nts"
    and aux: "wf_since_aux σ V R args φ'' ψ'' aux (progress σ P (Formula.Since φ''' I ψ'') j)"
    and args_ivl: "args_ivl args = I"
    and args_n: "args_n args = n"
    and args_L: "args_L args = Formula.fv φ''"
    and args_R: "args_R args = Formula.fv ψ''"
    by (cases rule: wf_mformula.cases) (auto)
  have φ''': "Formula.fv φ''' = Formula.fv φ''" "progress σ P φ''' j = progress σ P φ'' j"
    "progress σ P' φ''' j = progress σ P' φ'' j" for j
    using pos by (simp_all split: if_splits)
  from MSince.prems(2) have nts_snoc: "list_all2 (λi t. t = τ σ i)
    [min (progress σ P φ'' j) (progress σ P ψ'' j)..<Suc j] (nts @ [τ σ j])"
    using nts unfolding wf_ts_def
    by (auto simp add: wf_envs_progress_le[THEN min.coboundedI1] intro: list_all2_appendI)
  have update: "wf_since_aux σ V R args φ'' ψ'' (snd (zs, aux')) (progress σ P' (Formula.Since φ''' I ψ'') (Suc j)) 
    list_all2 (λi. qtable n (Formula.fv φ'''  Formula.fv ψ'') (mem_restr R)
      (λv. Formula.sat σ V (map the v) i (Formula.Since φ''' I ψ'')))
      [progress σ P (Formula.Since φ''' I ψ'') j..<progress σ P' (Formula.Since φ''' I ψ'') (Suc j)] (fst (zs, aux'))"
    if eval_φ: "fst (meval n (τ σ j) db φ) = xs"
      and eval_ψ: "fst (meval n (τ σ j) db ψ) = ys"
      and eq: "mbuf2t_take (λr1 r2 t (zs, aux).
        case update_since args r1 r2 t aux of (z, x)  (zs @ [z], x))
        ([], aux) (mbuf2_add xs ys buf) (nts @ [τ σ j]) = ((zs, aux'), buf', nts')"
    for xs ys zs aux' buf' nts'
    unfolding progress_simps φ'''
  proof (rule mbuf2t_take_add_induct'[where j=j and j'="Suc j" and z'="(zs, aux')",
      OF eq wf_envs_P_simps[OF MSince.prems(2)] buf nts_snoc],
      goal_cases xs ys _ base step)
    case xs
    then show ?case
      using MSince.IH(1)[OF φ MSince.prems(2)] eval_φ by auto
  next
    case ys
    then show ?case
      using MSince.IH(2)[OF ψ MSince.prems(2)] eval_ψ by auto
  next
    case base
    then show ?case
      using aux by (simp add: φ''')
  next
    case (step k X Y z)
    then show ?case
      using fvi_subset pos
      by (auto 0 3 simp: args_ivl args_n args_L args_R Un_absorb1
          elim!: update_since(1) list_all2_appendI dest!: update_since(2)
          split: prod.split if_splits)
  qed simp
  with MSince.IH(1)[OF φ MSince.prems(2)] MSince.IH(2)[OF ψ MSince.prems(2)] show ?case
    by (auto 0 3 simp: Since_eq split: prod.split
        intro: wf_mformula.Since[OF _ _ pos pos_eq args_ivl args_n args_L args_R fvi_subset]
        elim: mbuf2t_take_add'(1)[OF _ wf_envs_P_simps[OF MSince.prems(2)] buf nts_snoc]
              mbuf2t_take_add'(2)[OF _ wf_envs_P_simps[OF MSince.prems(2)] buf nts_snoc])
next
  case (MUntil args φ ψ buf nts aux)
  note sat.simps[simp del] progress_simps[simp del]
  from MUntil.prems obtain φ'' φ''' ψ'' I where Until_eq: "φ' = Formula.Until φ''' I ψ''"
    and pos: "if args_pos args then φ''' = φ'' else φ''' = Formula.Neg φ''"
    and pos_eq: "safe_formula φ''' = args_pos args"
    and φ: "wf_mformula σ j P V n R φ φ''"
    and ψ: "wf_mformula σ j P V n R ψ ψ''"
    and fvi_subset: "Formula.fv φ''  Formula.fv ψ''"
    and buf: "wf_mbuf2' σ P V j n R φ'' ψ'' buf"
    and nts: "wf_ts σ P j φ'' ψ'' nts"
    and aux: "wf_until_aux σ V R args φ'' ψ'' aux (progress σ P (Formula.Until φ''' I ψ'') j)"
    and args_ivl: "args_ivl args = I"
    and args_n: "args_n args = n"
    and args_L: "args_L args = Formula.fv φ''"
    and args_R: "args_R args = Formula.fv ψ''"
    and length_aux: "progress σ P (Formula.Until φ''' I ψ'') j + length_muaux args aux =
      min (progress σ P φ'' j) (progress σ P ψ'' j)"
    by (cases rule: wf_mformula.cases) (auto)
  define pos where args_pos: "pos = args_pos args"
  have φ''': "progress σ P φ''' j = progress σ P φ'' j"  "progress σ P' φ''' j = progress σ P' φ'' j" for j
    using pos by (simp_all add: progress.simps split: if_splits)
  from MUntil.prems(2) have nts_snoc: "list_all2 (λi t. t = τ σ i)
    [min (progress σ P φ'' j) (progress σ P ψ'' j)..<Suc j] (nts @ [τ σ j])"
    using nts unfolding wf_ts_def
    by (auto simp add: wf_envs_progress_le[THEN min.coboundedI1] intro: list_all2_appendI)
  {
    fix xs ys zs aux' aux'' buf' nts'
    assume eval_φ: "fst (meval n (τ σ j) db φ) = xs"
      and eval_ψ: "fst (meval n (τ σ j) db ψ) = ys"
      and eq1: "mbuf2t_take (add_new_muaux args) aux (mbuf2_add xs ys buf) (nts @ [τ σ j]) =
        (aux', buf', nts')"
      and eq2: "eval_muaux args (case nts' of []  τ σ j | nt # _  nt) aux' = (zs, aux'')"
    define ne where "ne  progress σ P (Formula.Until φ''' I ψ'') j"
    have update1: "wf_until_aux σ V R args φ'' ψ'' aux' (progress σ P (Formula.Until φ''' I ψ'') j) 
      ne + length_muaux args aux' = min (progress σ P' φ''' (Suc j)) (progress σ P' ψ'' (Suc j))"
      using MUntil.IH(1)[OF φ MUntil.prems(2)] eval_φ MUntil.IH(2)[OF ψ MUntil.prems(2)]
        eval_ψ nts_snoc nts_snoc length_aux aux fvi_subset
      unfolding φ'''
      by (elim mbuf2t_take_add_induct'[where j'="Suc j", OF eq1 wf_envs_P_simps[OF MUntil.prems(2)] buf])
        (auto simp: args_n args_L args_R ne_def wf_update_until)
    then obtain cur auxlist' where valid_aux': "valid_muaux args cur aux' auxlist'" and
      cur: "cur = (if ne + length auxlist' = 0 then 0 else τ σ (ne + length auxlist' - 1))" and
      wf_auxlist': "wf_until_auxlist σ V n R pos φ'' I ψ'' auxlist' (progress σ P (Formula.Until φ''' I ψ'') j)"
      unfolding wf_until_aux_def ne_def args_ivl args_n args_pos by auto
    have length_aux': "length_muaux args aux' = length auxlist'"
      using valid_length_muaux[OF valid_aux'] .
    have nts': "wf_ts σ P' (Suc j) φ'' ψ'' nts'"
      using MUntil.IH(1)[OF φ MUntil.prems(2)] eval_φ MUntil.IH(2)[OF ψ MUntil.prems(2)]
        MUntil.prems(2) eval_ψ nts_snoc
      unfolding wf_ts_def
      by (intro mbuf2t_take_eqD(2)[OF eq1]) (auto intro: wf_mbuf2_add buf[unfolded wf_mbuf2'_def])
    define zs'' where "zs'' = fst (eval_until I (case nts' of []  τ σ j | nt # x  nt) auxlist')"
    define auxlist'' where "auxlist'' = snd (eval_until I (case nts' of []  τ σ j | nt # x  nt) auxlist')"
    have current_w_le: "cur  (case nts' of []  τ σ j | nt # x  nt)"
    proof (cases nts')
      case Nil
      have p_le: "min (progress σ P' φ''' (Suc j)) (progress σ P' ψ'' (Suc j)) - 1  j"
        using wf_envs_progress_le[OF MUntil.prems(2)]
        by (auto simp: min_def le_diff_conv)
      then show ?thesis
        unfolding cur conjunct2[OF update1, unfolded length_aux']
        using Nil by auto
    next
      case (Cons nt x)
      have progress_φ''': "progress σ P' φ'' (Suc j) = progress σ P' φ''' (Suc j)"
        using pos by (auto simp add: progress.simps split: if_splits)
      have "nt = τ σ (min (progress σ P' φ'' (Suc j)) (progress σ P' ψ'' (Suc j)))"
        using nts'[unfolded wf_ts_def Cons]
        unfolding list_all2_Cons2 upt_eq_Cons_conv by auto
      then show ?thesis
        unfolding cur conjunct2[OF update1, unfolded length_aux'] Cons progress_φ'''
        by (auto split: if_splits list.splits intro!: τ_mono)
    qed
    have valid_aux'': "valid_muaux args cur aux'' auxlist''"
      using valid_eval_muaux[OF valid_aux' current_w_le eq2, of zs'' auxlist'']
      by (auto simp add: args_ivl zs''_def auxlist''_def)
    have length_aux'': "length_muaux args aux'' = length auxlist''"
      using valid_length_muaux[OF valid_aux''] .
    have eq2': "eval_until I (case nts' of []  τ σ j | nt # _  nt) auxlist' = (zs, auxlist'')"
      using valid_eval_muaux[OF valid_aux' current_w_le eq2, of zs'' auxlist'']
      by (auto simp add: args_ivl zs''_def auxlist''_def)
    have length_aux'_aux'': "length_muaux args aux' = length zs + length_muaux args aux''"
      using eval_until_length[OF eq2'] unfolding length_aux' length_aux'' .
    have "i  progress σ P' (Formula.Until φ''' I ψ'') (Suc j) 
      wf_until_auxlist σ V n R pos φ'' I ψ'' auxlist' i 
      i + length auxlist' = min (progress σ P' φ''' (Suc j)) (progress σ P' ψ'' (Suc j)) 
      wf_until_auxlist σ V n R pos φ'' I ψ'' auxlist'' (progress σ P' (Formula.Until φ''' I ψ'') (Suc j)) 
        i + length zs = progress σ P' (Formula.Until φ''' I ψ'') (Suc j) 
        i + length zs + length auxlist'' = min (progress σ P' φ''' (Suc j)) (progress σ P' ψ'' (Suc j)) 
        list_all2 (λi. qtable n (Formula.fv ψ'') (mem_restr R)
          (λv. Formula.sat σ V (map the v) i (Formula.Until (if pos then φ'' else Formula.Neg φ'') I ψ'')))
          [i..<i + length zs] zs" for i
      using eq2'
    proof (induction auxlist' arbitrary: zs auxlist'' i)
      case Nil
      then show ?case
        by (auto dest!: antisym[OF progress_Until_le])
    next
      case (Cons a aux')
      obtain t a1 a2 where "a = (t, a1, a2)" by (cases a)
      from Cons.prems(2) have aux': "wf_until_auxlist σ V n R pos φ'' I ψ'' aux' (Suc i)"
        by (rule wf_until_aux_Cons)
      from Cons.prems(2) have 1: "t = τ σ i"
        unfolding a = (t, a1, a2) by (rule wf_until_aux_Cons1)
      from Cons.prems(2) have 3: "qtable n (Formula.fv ψ'') (mem_restr R) (λv.
        (ji. j < Suc (i + length aux')  mem (τ σ j - τ σ i) I  Formula.sat σ V (map the v) j ψ'' 
        (k{i..<j}. if pos then Formula.sat σ V (map the v) k φ'' else ¬ Formula.sat σ V (map the v) k φ''))) a2"
        unfolding a = (t, a1, a2) by (rule wf_until_aux_Cons3)
      from Cons.prems(3) have Suc_i_aux': "Suc i + length aux' =
          min (progress σ P' φ''' (Suc j)) (progress σ P' ψ'' (Suc j))"
        by simp
      have "i  progress σ P' (Formula.Until φ''' I ψ'') (Suc j)"
        if "enat (case nts' of []  τ σ j | nt # x  nt)  enat t + right I"
        using that nts' unfolding wf_ts_def progress.simps
        by (auto simp add: 1 list_all2_Cons2 upt_eq_Cons_conv φ'''
            intro!: cInf_lower τ_mono elim!: order.trans[rotated] simp del: upt_Suc split: if_splits list.splits)
      moreover
      have "Suc i  progress σ P' (Formula.Until φ''' I ψ'') (Suc j)"
        if "enat t + right I < enat (case nts' of []  τ σ j | nt # x  nt)"
      proof -
        from that obtain m where m: "right I = enat m" by (cases "right I") auto
        have τ_min:  σ (min j k) = min (τ σ j) (τ σ k)" for k
          by (simp add: min_of_mono monoI)
        have le_progress_iff[simp]: "(Suc j)  progress σ P' φ (Suc j)  progress σ P' φ (Suc j) = (Suc j)" for φ
          using wf_envs_progress_le[OF MUntil.prems(2), of φ] by auto
        have min_Suc[simp]: "min j (Suc j) = j" by auto
        let ?X = "{i. k. k < Suc j  k min (progress σ P' φ''' (Suc j)) (progress σ P' ψ'' (Suc j))  enat (τ σ k)  enat (τ σ i) + right I}"
        let ?min = "min j (min (progress σ P' φ'' (Suc j)) (progress σ P' ψ'' (Suc j)))"
        have σ ?min  τ σ j"
          by (rule τ_mono) auto
        from m have "?X  {}"
          by (auto dest!: τ_mono[of _ "progress σ P' φ'' (Suc j)" σ]
              simp: not_le not_less φ''' intro!: exI[of _ "progress σ P' φ'' (Suc j)"])
        from m show ?thesis
          using that nts' unfolding wf_ts_def progress.simps
          by (intro cInf_greatest[OF ?X  {}])
            (auto simp: 1 φ''' not_le not_less list_all2_Cons2 upt_eq_Cons_conv less_Suc_eq
              simp del: upt_Suc split: list.splits if_splits
              dest!: spec[of _ "?min"] less_le_trans[of σ i + m" σ _" σ _ + m"] less_τD)
      qed
      moreover have *: "k < progress σ P' ψ (Suc j)" if
        "enat (τ σ i) + right I < enat (case nts' of []  τ σ j | nt # x  nt)"
        "enat (τ σ k - τ σ i)  right I" "ψ = ψ''  ψ = φ''" for k ψ
      proof -
        from that(1,2) obtain m where "right I = enat m"
          σ i + m < (case nts' of []  τ σ j | nt # x  nt)" σ k - τ σ i  m"
          by (cases "right I") auto
        with that(3) nts' progress_le[of σ ψ'' "Suc j"] progress_le[of σ φ'' "Suc j"]
        show ?thesis
          unfolding wf_ts_def le_diff_conv
          by (auto simp: not_le list_all2_Cons2 upt_eq_Cons_conv less_Suc_eq add.commute
              simp del: upt_Suc split: list.splits if_splits dest!: le_less_trans[of σ k"] less_τD)
      qed
      ultimately show ?case using Cons.prems Suc_i_aux'[simplified]
        unfolding a = (t, a1, a2)
        by (auto simp: φ''' 1 sat.simps upt_conv_Cons dest!:  Cons.IH[OF _ aux' Suc_i_aux']
            simp del: upt_Suc split: if_splits prod.splits intro!: iff_exI qtable_cong[OF 3 refl])
    qed
    thm this
    note wf_aux'' = this[OF wf_envs_progress_mono[OF MUntil.prems(2) le_SucI[OF order_refl]]
      wf_auxlist' conjunct2[OF update1, unfolded ne_def length_aux']]
    have "progress σ P (formula.Until φ''' I ψ'') j + length auxlist' =
      progress σ P' (formula.Until φ''' I ψ'') (Suc j) + length auxlist''"
      using wf_aux'' valid_aux'' length_aux'_aux''
      by (auto simp add: ne_def length_aux' length_aux'')
    then have "cur =
      (if progress σ P' (formula.Until φ''' I ψ'') (Suc j) + length auxlist'' = 0 then 0
      else τ σ (progress σ P' (formula.Until φ''' I ψ'') (Suc j) + length auxlist'' - 1))"
      unfolding cur ne_def by auto
    then have "wf_until_aux σ V R args φ'' ψ'' aux'' (progress σ P' (formula.Until φ''' I ψ'') (Suc j)) 
      progress σ P (formula.Until φ''' I ψ'') j + length zs = progress σ P' (formula.Until φ''' I ψ'') (Suc j) 
      progress σ P (formula.Until φ''' I ψ'') j + length zs + length_muaux args aux'' = min (progress σ P' φ''' (Suc j)) (progress σ P' ψ'' (Suc j)) 
      list_all2 (λi. qtable n (fv ψ'') (mem_restr R) (λv. Formula.sat σ V (map the v) i (formula.Until (if pos then φ'' else formula.Neg φ'') I ψ'')))
      [progress σ P (formula.Until φ''' I ψ'') j..<progress σ P (formula.Until φ''' I ψ'') j + length zs] zs"
      using wf_aux'' valid_aux'' fvi_subset
      unfolding wf_until_aux_def length_aux'' args_ivl args_n args_pos by (auto simp only: length_aux'')
  }
  note update = this
  from MUntil.IH(1)[OF φ MUntil.prems(2)] MUntil.IH(2)[OF ψ MUntil.prems(2)] pos pos_eq fvi_subset show ?case
    by (auto 0 4 simp: args_ivl args_n args_pos Until_eq φ''' progress.simps(6) split: prod.split if_splits
        dest!: update[OF refl refl, rotated]
        intro!: wf_mformula.Until[OF _ _ _ _ args_ivl args_n args_L args_R fvi_subset]
        elim!: list.rel_mono_strong qtable_cong
        elim: mbuf2t_take_add'(1)[OF _ wf_envs_P_simps[OF MUntil.prems(2)] buf nts_snoc]
              mbuf2t_take_add'(2)[OF _ wf_envs_P_simps[OF MUntil.prems(2)] buf nts_snoc])
next
  case (MMatchP I mr mrs φs buf nts aux)
  note sat.simps[simp del] mbufnt_take.simps[simp del] mbufn_add.simps[simp del]
  from MMatchP.prems obtain r ψs where eq: "φ' = Formula.MatchP I r"
    and safe: "safe_regex Past Strict r"
    and mr: "to_mregex r = (mr, ψs)"
    and mrs: "mrs = sorted_list_of_set (RPDs mr)"
    and ψs: "list_all2 (wf_mformula σ j P V n R) φs ψs"
    and buf: "wf_mbufn' σ P V j n R r buf"
    and nts: "wf_ts_regex σ P j r nts"
    and aux: "wf_matchP_aux σ V n R I r aux (progress σ P (Formula.MatchP I r) j)"
    by (cases rule: wf_mformula.cases) (auto)
  have nts_snoc: "list_all2 (λi t. t = τ σ i) [progress_regex σ P r j..<Suc j] (nts @ [τ σ j])"
    using nts unfolding wf_ts_regex_def
    by (auto simp add: wf_envs_progress_regex_le[OF MMatchP.prems(2)] intro: list_all2_appendI)
  have update: "wf_matchP_aux σ V n R I r (snd (zs, aux')) (progress σ P' (Formula.MatchP I r) (Suc j)) 
    list_all2 (λi. qtable n (Formula.fv_regex r) (mem_restr R)
      (λv. Formula.sat σ V (map the v) i (Formula.MatchP I r)))
      [progress σ P (Formula.MatchP I r) j..<progress σ P' (Formula.MatchP I r) (Suc j)] (fst (zs, aux'))"
    if eval: "map (fst o meval n (τ σ j) db) φs = xss"
      and eq: "mbufnt_take (λrels t (zs, aux).
        case update_matchP n I mr mrs rels t aux of (z, x)  (zs @ [z], x))
        ([], aux) (mbufn_add xss buf) (nts @ [τ σ j]) = ((zs, aux'), buf', nts')"
    for xss zs aux' buf' nts'
    unfolding progress_simps
  proof (rule mbufnt_take_add_induct'[where j'="Suc j" and z'="(zs, aux')", OF eq wf_envs_P_simps[OF MMatchP.prems(2)] safe mr buf nts_snoc],
      goal_cases xss _ base step)
    case xss
    then show ?case
      using eval ψs
      by (auto simp: list_all3_map map2_map_map list_all3_list_all2_conv list.rel_map
          list.rel_flip[symmetric, of _ ψs φs] dest!: MMatchP.IH(1)[OF _ _ MMatchP.prems(2)]
          elim!: list.rel_mono_strong split: prod.splits)
  next
    case base
    then show ?case
      using aux by auto
  next
    case (step k Xs z)
    then show ?case
      by (auto simp: Un_absorb1 mrs safe mr elim!: update_matchP(1) list_all2_appendI
          dest!: update_matchP(2) split: prod.split)
  qed simp
  then show ?case using ψs
    by (auto simp: eq mr mrs safe map_split_alt list.rel_flip[symmetric, of _ ψs φs]
        list_all3_map map2_map_map list_all3_list_all2_conv list.rel_map intro!: wf_mformula.intros
        elim!: list.rel_mono_strong mbufnt_take_add'(1)[OF _ wf_envs_P_simps[OF MMatchP.prems(2)] safe mr buf nts_snoc]
        mbufnt_take_add'(2)[OF _ wf_envs_P_simps[OF MMatchP.prems(2)] safe mr buf nts_snoc]
        dest!: MMatchP.IH[OF _ _ MMatchP.prems(2)] split: prod.splits)
next
  case (MMatchF I mr mrs φs buf nts aux)
  note sat.simps[simp del] mbufnt_take.simps[simp del] mbufn_add.simps[simp del] progress_simps[simp del]
  from MMatchF.prems obtain r ψs where eq: "φ' = Formula.MatchF I r"
    and safe: "safe_regex Futu Strict r"
    and mr: "to_mregex r = (mr, ψs)"
    and mrs: "mrs = sorted_list_of_set (LPDs mr)"
    and ψs: "list_all2 (wf_mformula σ j P V n R) φs ψs"
    and buf: "wf_mbufn' σ P V j n R r buf"
    and nts: "wf_ts_regex σ P j r nts"
    and aux: "wf_matchF_aux σ V n R I r aux (progress σ P (Formula.MatchF I r) j) 0"
    and length_aux: "progress σ P (Formula.MatchF I r) j + length aux = progress_regex σ P r j"
    by (cases rule: wf_mformula.cases) (auto)
  have nts_snoc: "list_all2 (λi t. t = τ σ i)
    [progress_regex σ P r j..<Suc j] (nts @ [τ σ j])"
    using nts unfolding wf_ts_regex_def
    by (auto simp add: wf_envs_progress_regex_le[OF MMatchF.prems(2)] intro: list_all2_appendI)
  {
    fix xss zs aux' aux'' buf' nts'
    assume eval: "map (fst o meval n (τ σ j) db) φs = xss"
      and eq1: "mbufnt_take (update_matchF n I mr mrs) aux (mbufn_add xss buf) (nts @ [τ σ j]) =
        (aux', buf', nts')"
      and eq2: "eval_matchF I mr (case nts' of []  τ σ j | nt # _  nt) aux' = (zs, aux'')"
    have update1: "wf_matchF_aux σ V n R I r aux' (progress σ P (Formula.MatchF I r) j) 0 
      progress σ P (Formula.MatchF I r) j + length aux' = progress_regex σ P' r (Suc j)"
      using eval nts_snoc nts_snoc length_aux aux ψs
      by (elim mbufnt_take_add_induct'[where j'="Suc j", OF eq1 wf_envs_P_simps[OF MMatchF.prems(2)] safe mr buf])
        (auto simp: length_update_matchF
          list_all3_map map2_map_map list_all3_list_all2_conv list.rel_map list.rel_flip[symmetric, of _ ψs φs]
          dest!: MMatchF.IH[OF _ _ MMatchF.prems(2)]
          elim: wf_update_matchF[OF _ safe mr mrs] elim!: list.rel_mono_strong)
    from MMatchF.prems(2) have nts': "wf_ts_regex σ P' (Suc j) r nts'"
      using eval eval nts_snoc ψs
      unfolding wf_ts_regex_def
      by (intro mbufnt_take_eqD(2)[OF eq1 wf_mbufn_add[where js'="map (λφ. progress σ P' φ (Suc j)) ψs",
              OF buf[unfolded wf_mbufn'_def mr prod.case]]])
        (auto simp: to_mregex_progress[OF safe mr] Mini_def
          list_all3_map map2_map_map list_all3_list_all2_conv list.rel_map list.rel_flip[symmetric, of _ ψs φs]
          list_all2_Cons1 elim!: list.rel_mono_strong intro!: list.rel_refl_strong
          dest!: MMatchF.IH[OF _ _ MMatchF.prems(2)])
    have "i  progress σ P' (Formula.MatchF I r) (Suc j) 
      wf_matchF_aux σ V n R I r aux' i 0 
      i + length aux' = progress_regex σ P' r (Suc j) 
      wf_matchF_aux σ V n R I r aux'' (progress σ P' (Formula.MatchF I r) (Suc j)) 0 
        i + length zs = progress σ P' (Formula.MatchF I r) (Suc j) 
        i + length zs + length aux'' = progress_regex σ P' r (Suc j) 
        list_all2 (λi. qtable n (Formula.fv_regex r) (mem_restr R)
          (λv. Formula.sat σ V (map the v) i (Formula.MatchF I r)))
          [i..<i + length zs] zs" for i
      using eq2
    proof (induction aux' arbitrary: zs aux'' i)
      case Nil
      then show ?case by (auto dest!: antisym[OF progress_MatchF_le])
    next
      case (Cons a aux')
      obtain t rels rel where "a = (t, rels, rel)" by (cases a)
      from Cons.prems(2) have aux': "wf_matchF_aux σ V n R I r aux' (Suc i) 0"
        by (rule wf_matchF_aux_Cons)
      from Cons.prems(2) have 1: "t = τ σ i"
        unfolding a = (t, rels, rel) by (rule wf_matchF_aux_Cons1)
      from Cons.prems(2) have 3: "qtable n (Formula.fv_regex r) (mem_restr R) (λv.
        (ji. j < Suc (i + length aux')  mem (τ σ j - τ σ i) I  Regex.match (Formula.sat σ V (map the v)) r i j)) rel"
        unfolding a = (t, rels, rel) using wf_matchF_aux_Cons3 by force
      from Cons.prems(3) have Suc_i_aux': "Suc i + length aux' = progress_regex σ P' r (Suc j)"
        by simp
      have "i  progress σ P' (Formula.MatchF I r) (Suc j)"
        if "enat (case nts' of []  τ σ j | nt # x  nt)  enat t + right I"
        using that nts' unfolding wf_ts_regex_def progress_simps
        by (auto simp add: 1 list_all2_Cons2 upt_eq_Cons_conv
            intro!: cInf_lower τ_mono elim!: order.trans[rotated] simp del: upt_Suc split: if_splits list.splits)
      moreover
      have "Suc i  progress σ P' (Formula.MatchF I r) (Suc j)"
        if "enat t + right I < enat (case nts' of []  τ σ j | nt # x  nt)"
      proof -
        from that obtain m where m: "right I = enat m" by (cases "right I") auto
        have τ_min:  σ (min j k) = min (τ σ j) (τ σ k)" for k
          by (simp add: min_of_mono monoI)
        have le_progress_iff[simp]: "Suc j  progress σ P' φ (Suc j)  progress σ P' φ (Suc j) = (Suc j)" for φ
          using wf_envs_progress_le[OF MMatchF.prems(2), of φ] by auto
        have min_Suc[simp]: "min j (Suc j) = j" by auto
        let ?X = "{i. k. k < Suc j  k  progress_regex σ P' r (Suc j)  enat (τ σ k)  enat (τ σ i) + right I}"
        let ?min = "min j (progress_regex σ P' r (Suc j))"
        have σ ?min  τ σ j"
          by (rule τ_mono) auto
        from m have "?X  {}"
          by (auto dest!: less_τD add_lessD1 simp: not_le not_less)
        from m show ?thesis
          using that nts' wf_envs_progress_regex_le[OF MMatchF.prems(2), of r]
          unfolding wf_ts_regex_def progress_simps
          by (intro cInf_greatest[OF ?X  {}])
            (auto simp: 1 not_le not_less list_all2_Cons2 upt_eq_Cons_conv less_Suc_eq
              simp del: upt_Suc split: list.splits if_splits
              dest!: spec[of _ "?min"] less_le_trans[of σ i + m" σ _" σ _ + m"] less_τD)
      qed
      moreover have *: "k < progress_regex σ P' r (Suc j)" if
        "enat (τ σ i) + right I < enat (case nts' of []  τ σ j | nt # x  nt)"
        "enat (τ σ k - τ σ i)  right I" for k
      proof -
        from that(1,2) obtain m where "right I = enat m"
          σ i + m < (case nts' of []  τ σ j | nt # x  nt)" σ k - τ σ i  m"
          by (cases "right I") auto
        with nts' wf_envs_progress_regex_le[OF MMatchF.prems(2), of r]
        show ?thesis
          unfolding wf_ts_regex_def le_diff_conv
          by (auto simp: not_le list_all2_Cons2 upt_eq_Cons_conv less_Suc_eq add.commute
              simp del: upt_Suc split: list.splits if_splits dest!: le_less_trans[of σ k"] less_τD)
      qed
      ultimately show ?case using Cons.prems Suc_i_aux'[simplified]
        unfolding a = (t, rels, rel)
        by (auto simp: 1 sat.simps upt_conv_Cons dest!:  Cons.IH[OF _ aux' Suc_i_aux']
            simp del: upt_Suc split: if_splits prod.splits intro!: iff_exI qtable_cong[OF 3 refl])

    qed
    note this[OF progress_mono_gen[OF le_SucI, OF order.refl] conjunct1[OF update1] conjunct2[OF update1]]
  }
  note update = this[OF refl, rotated]
  with MMatchF.prems(2) show ?case using ψs
    by (auto simp: eq mr mrs safe map_split_alt list.rel_flip[symmetric, of _ ψs φs]
        list_all3_map map2_map_map list_all3_list_all2_conv list.rel_map intro!: wf_mformula.intros
        elim!: list.rel_mono_strong mbufnt_take_add'(1)[OF _ wf_envs_P_simps[OF MMatchF.prems(2)] safe mr buf nts_snoc]
        mbufnt_take_add'(2)[OF _ wf_envs_P_simps[OF MMatchF.prems(2)] safe mr buf nts_snoc]
        dest!: MMatchF.IH[OF _ _ MMatchF.prems(2)] update split: prod.splits)
qed


subsubsection ‹Monitor step›

lemma (in maux) wf_mstate_mstep: "wf_mstate φ π R st  last_ts π  snd tdb 
  wf_mstate φ (psnoc π tdb) R (snd (mstep (map_prod mk_db id tdb) st))"
  unfolding wf_mstate_def mstep_def Let_def
  by (fastforce simp add: progress_mono le_imp_diff_is_add split: prod.splits
      elim!: prefix_of_psnocE dest: meval[OF _ wf_envs_mk_db] list_all2_lengthD)

definition "flatten_verdicts Vs = ( (set (map (λ(i, X). (λv. (i, v)) ` X) Vs)))"

lemma flatten_verdicts_append[simp]:
  "flatten_verdicts (Vs @ Us) = flatten_verdicts Vs  flatten_verdicts Us"
  by (induct Vs) (auto simp: flatten_verdicts_def)

lemma (in maux) mstep_output_iff:
  assumes "wf_mstate φ π R st" "last_ts π  snd tdb" "prefix_of (psnoc π tdb) σ" "mem_restr R v"
  shows "(i, v)  flatten_verdicts (fst (mstep (map_prod mk_db id tdb) st)) 
    progress σ Map.empty φ (plen π)  i  i < progress σ Map.empty φ (Suc (plen π)) 
    wf_tuple (Formula.nfv φ) (Formula.fv φ) v  Formula.sat σ Map.empty (map the v) i φ"
proof -
  from prefix_of_psnocE[OF assms(3,2)] have "prefix_of π σ"
    σ (plen π) = fst tdb" σ (plen π) = snd tdb" by auto
  moreover from assms(1) ‹prefix_of π σ have "mstate_n st = Formula.nfv φ"
    "mstate_i st = progress σ Map.empty φ (plen π)" "wf_mformula σ (plen π) Map.empty Map.empty (mstate_n st) R (mstate_m st) φ"
    unfolding wf_mstate_def by blast+
  moreover from meval[OF ‹wf_mformula σ (plen π) Map.empty Map.empty (mstate_n st) R (mstate_m st) φ wf_envs_mk_db] obtain Vs st' where
    "meval (mstate_n st) (τ σ (plen π)) (mk_db (Γ σ (plen π))) (mstate_m st) = (Vs, st')"
    "wf_mformula σ (Suc (plen π))  Map.empty Map.empty (mstate_n st) R st' φ"
    "list_all2 (λi. qtable (mstate_n st) (fv φ) (mem_restr R) (λv. Formula.sat σ Map.empty (map the v) i φ))
      [progress σ Map.empty φ (plen π)..<progress σ Map.empty φ (Suc (plen π))] Vs" by blast
  moreover from this assms(4) have "qtable (mstate_n st) (fv φ) (mem_restr R)
    (λv. Formula.sat σ Map.empty (map the v) i φ) (Vs ! (i - progress σ Map.empty φ (plen π)))"
    if "progress σ Map.empty φ (plen π)  i" "i < progress σ Map.empty φ (Suc (plen π))"
    using that by (auto simp: list_all2_conv_all_nth
        dest!: spec[of _ "(i - progress σ Map.empty φ (plen π))"])
  ultimately show ?thesis
    using assms(4) unfolding mstep_def Let_def flatten_verdicts_def
    by (auto simp: in_set_enumerate_eq list_all2_conv_all_nth progress_mono le_imp_diff_is_add
        elim!: in_qtableE in_qtableI intro!: bexI[of _ "(i, Vs ! (i - progress σ Map.empty φ (plen π)))"])
qed


subsubsection ‹Monitor function›

locale verimon = verimon_spec + maux

lemma (in verimon) mstep_mverdicts:
  assumes wf: "wf_mstate φ π R st"
    and le[simp]: "last_ts π  snd tdb"
    and restrict: "mem_restr R v"
  shows "(i, v)  flatten_verdicts (fst (mstep (map_prod mk_db id tdb) st)) 
    (i, v)  M (psnoc π tdb) - M π"
proof -
  obtain σ where p2: "prefix_of (psnoc π tdb) σ"
    using ex_prefix_of by blast
  with le have p1: "prefix_of π σ" by (blast elim!: prefix_of_psnocE)
  show ?thesis
    unfolding M_def
    by (auto 0 3 simp: p2 progress_prefix_conv[OF _ p1] sat_prefix_conv[OF _ p1] not_less
        pprogress_eq[OF p1] pprogress_eq[OF p2]
        dest: mstep_output_iff[OF wf le p2 restrict, THEN iffD1] spec[of _ σ]
        mstep_output_iff[OF wf le _ restrict, THEN iffD1] progress_sat_cong[OF p1]
        intro: mstep_output_iff[OF wf le p2 restrict, THEN iffD2] p1)
qed

context maux
begin

primrec msteps0 where
  "msteps0 [] st = ([], st)"
| "msteps0 (tdb # π) st =
    (let (V', st') = mstep (map_prod mk_db id tdb) st; (V'', st'') = msteps0 π st' in (V' @ V'', st''))"

primrec msteps0_stateless where
  "msteps0_stateless [] st = []"
| "msteps0_stateless (tdb # π) st = (let (V', st') = mstep (map_prod mk_db id tdb) st in V' @ msteps0_stateless π st')"

lemma msteps0_msteps0_stateless: "fst (msteps0 w st) = msteps0_stateless w st"
  by (induct w arbitrary: st) (auto simp: split_beta)

lift_definition msteps :: "Formula.prefix  ('msaux, 'muaux) mstate  (nat × event_data table) list × ('msaux, 'muaux) mstate"
  is msteps0 .

lift_definition msteps_stateless :: "Formula.prefix  ('msaux, 'muaux) mstate  (nat × event_data table) list"
  is msteps0_stateless .

lemma msteps_msteps_stateless: "fst (msteps w st) = msteps_stateless w st"
  by transfer (rule msteps0_msteps0_stateless)

lemma msteps0_snoc: "msteps0 (π @ [tdb]) st =
   (let (V', st') = msteps0 π st; (V'', st'') = mstep (map_prod mk_db id tdb) st' in (V' @ V'', st''))"
  by (induct π arbitrary: st) (auto split: prod.splits)

lemma msteps_psnoc: "last_ts π  snd tdb  msteps (psnoc π tdb) st =
   (let (V', st') = msteps π st; (V'', st'') = mstep (map_prod mk_db id tdb) st' in (V' @ V'', st''))"
  by transfer' (auto simp: msteps0_snoc split: list.splits prod.splits if_splits)

definition monitor where
  "monitor φ π = msteps_stateless π (minit_safe φ)"

end

lemma Suc_length_conv_snoc: "(Suc n = length xs) = (y ys. xs = ys @ [y]  length ys = n)"
  by (cases xs rule: rev_cases) auto

lemma (in verimon) wf_mstate_msteps: "wf_mstate φ π R st  mem_restr R v  π  π' 
  X = msteps (pdrop (plen π) π') st  wf_mstate φ π' R (snd X) 
  ((i, v)  flatten_verdicts (fst X)) = ((i, v)  M π' - M π)"
proof (induct "plen π' - plen π" arbitrary: X st π π')
  case 0
  from 0(1,4,5) have "π = π'"  "X = ([], st)"
    by (transfer; auto)+
  with 0(2) show ?case unfolding flatten_verdicts_def by simp
next
  case (Suc x)
  from Suc(2,5) obtain π'' tdb where "x = plen π'' - plen π"  "π  π''"
    "π' = psnoc π'' tdb" "pdrop (plen π) (psnoc π'' tdb) = psnoc (pdrop (plen π) π'') tdb"
    "last_ts (pdrop (plen π) π'')  snd tdb" "last_ts π''  snd tdb"
    "π''  psnoc π'' tdb"
  proof (atomize_elim, transfer, elim exE, goal_cases prefix)
    case (prefix _ _ π' _ π_tdb)
    then show ?case
    proof (cases π_tdb rule: rev_cases)
      case (snoc π tdb)
      with prefix show ?thesis
        by (intro bexI[of _ "π' @ π"] exI[of _ tdb])
          (force simp: sorted_append append_eq_Cons_conv split: list.splits if_splits)+
    qed simp
  qed
  with Suc(1)[OF this(1) Suc.prems(1,2) this(2) refl] Suc.prems show ?case
    unfolding msteps_msteps_stateless[symmetric]
    by (auto simp: msteps_psnoc split_beta mstep_mverdicts
        dest: mono_monitor[THEN set_mp, rotated] intro!: wf_mstate_mstep)
qed

lemma (in verimon) wf_mstate_msteps_stateless:
  assumes "wf_mstate φ π R st" "mem_restr R v" "π  π'"
  shows "(i, v)  flatten_verdicts (msteps_stateless (pdrop (plen π) π') st)  (i, v)  M π' - M π"
  using wf_mstate_msteps[OF assms refl] unfolding msteps_msteps_stateless by simp

lemma (in verimon) wf_mstate_msteps_stateless_UNIV: "wf_mstate φ π UNIV st  π  π' 
  flatten_verdicts (msteps_stateless (pdrop (plen π) π') st) = M π' - M π"
  by (auto dest: wf_mstate_msteps_stateless[OF _ mem_restr_UNIV])

lemma (in verimon) mverdicts_Nil: "M pnil = {}"
  by (simp add: M_def pprogress_eq)

context maux
begin

lemma minit_safe_minit: "mmonitorable φ  minit_safe φ = minit φ"
  unfolding minit_safe_def monitorable_formula_code by simp

lemma wf_mstate_minit_safe: "mmonitorable φ  wf_mstate φ pnil R (minit_safe φ)"
  using wf_mstate_minit minit_safe_minit mmonitorable_def by metis

end

lemma (in verimon) monitor_mverdicts: "flatten_verdicts (monitor φ π) = M π"
  unfolding monitor_def using monitorable
  by (subst wf_mstate_msteps_stateless_UNIV[OF wf_mstate_minit_safe, simplified])
    (auto simp: mmonitorable_def mverdicts_Nil)

subsection ‹Collected correctness results›

context verimon
begin

text ‹We summarize the main results proved above.
\begin{enumerate}
\item The term @{term M} describes semantically the monitor's expected behaviour:
\begin{itemize}
\item @{thm[source] mono_monitor}: @{thm mono_monitor[no_vars]}
\item @{thm[source] sound_monitor}: @{thm sound_monitor[no_vars]}
\item @{thm[source] complete_monitor}: @{thm complete_monitor[no_vars]}
\item @{thm[source] sliceable_M}: @{thm sliceable_M[no_vars]}
\end{itemize}
\item The executable monitor's online interface @{term minit_safe} and @{term mstep}
  preserves the invariant @{term wf_mstate} and produces the the verdicts according
  to @{term M}:
\begin{itemize}
\item @{thm[source] wf_mstate_minit_safe}: @{thm wf_mstate_minit_safe[no_vars]}
\item @{thm[source] wf_mstate_mstep}: @{thm wf_mstate_mstep[no_vars]}
\item @{thm[source] mstep_mverdicts}: @{thm mstep_mverdicts[no_vars]}
\end{itemize}
\item The executable monitor's offline interface @{term monitor} implements @{term M}:
\begin{itemize}
\item @{thm[source] monitor_mverdicts}: @{thm monitor_mverdicts[no_vars]}
\end{itemize}
\end{enumerate}
›

end

(*<*)
end
(*>*)

Theory Optimized_MTL

(*<*)
theory Optimized_MTL
  imports Monitor
begin
(*>*)

section ‹Efficient implementation of temporal operators›

subsection ‹Optimized queue data structure›

lemma less_enat_iff: "a < enat i  (j. a = enat j  j < i)"
  by (cases a) auto

type_synonym 'a queue_t = "'a list × 'a list"

definition queue_invariant :: "'a queue_t  bool" where
  "queue_invariant q = (case q of ([], [])  True | (fs, l # ls)  True | _  False)"

typedef 'a queue = "{q :: 'a queue_t. queue_invariant q}"
  by (auto simp: queue_invariant_def split: list.splits)

setup_lifting type_definition_queue

lift_definition linearize :: "'a queue  'a list" is "(λq. case q of (fs, ls)  fs @ rev ls)" .

lift_definition empty_queue :: "'a queue" is "([], [])"
  by (auto simp: queue_invariant_def split: list.splits)

lemma empty_queue_rep: "linearize empty_queue = []"
  by transfer (simp add: empty_queue_def linearize_def)

lift_definition is_empty :: "'a queue  bool" is "λq. (case q of ([], [])  True | _  False)" .

lemma linearize_t_Nil: "(case q of (fs, ls)  fs @ rev ls) = []  q = ([], [])"
  by (auto split: prod.splits)

lemma is_empty_alt: "is_empty q  linearize q = []"
  by transfer (auto simp: linearize_t_Nil list.case_eq_if)

fun prepend_queue_t :: "'a  'a queue_t  'a queue_t" where
  "prepend_queue_t a ([], []) = ([], [a])"
| "prepend_queue_t a (fs, l # ls) = (a # fs, l # ls)"
| "prepend_queue_t a (f # fs, []) = undefined"

lift_definition prepend_queue :: "'a  'a queue  'a queue" is prepend_queue_t
  by (auto simp: queue_invariant_def split: list.splits elim: prepend_queue_t.elims)

lemma prepend_queue_rep: "linearize (prepend_queue a q) = a # linearize q"
  by transfer
    (auto simp add: queue_invariant_def linearize_def elim: prepend_queue_t.elims split: prod.splits)

lift_definition append_queue :: "'a  'a queue  'a queue" is
  "(λa q. case q of (fs, ls)  (fs, a # ls))"
  by (auto simp: queue_invariant_def split: list.splits)

lemma append_queue_rep: "linearize (append_queue a q) = linearize q @ [a]"
  by transfer (auto simp add: linearize_def split: prod.splits)

fun safe_last_t :: "'a queue_t  'a option × 'a queue_t" where
  "safe_last_t ([], []) = (None, ([], []))"
| "safe_last_t (fs, l # ls) = (Some l, (fs, l # ls))"
| "safe_last_t (f # fs, []) = undefined"

lift_definition safe_last :: "'a queue  'a option × 'a queue" is safe_last_t
  by (auto simp: queue_invariant_def split: prod.splits list.splits)

lemma safe_last_rep: "safe_last q = (α, q')  linearize q = linearize q' 
  (case α of None  linearize q = [] | Some a  linearize q  []  a = last (linearize q))"
  by transfer (auto simp: queue_invariant_def split: list.splits elim: safe_last_t.elims)

fun safe_hd_t :: "'a queue_t  'a option × 'a queue_t" where
  "safe_hd_t ([], []) = (None, ([], []))"
| "safe_hd_t ([], [l]) = (Some l, ([], [l]))"
| "safe_hd_t ([], l # ls) = (let fs = rev ls in (Some (hd fs), (fs, [l])))"
| "safe_hd_t (f # fs, l # ls) = (Some f, (f # fs, l # ls))"
| "safe_hd_t (f # fs, []) = undefined"

lift_definition(code_dt) safe_hd :: "'a queue  'a option × 'a queue" is safe_hd_t
proof -
  fix q :: "'a queue_t"
  assume "queue_invariant q"
  then show "pred_prod  queue_invariant (safe_hd_t q)"
    by (cases q rule: safe_hd_t.cases) (auto simp: queue_invariant_def Let_def split: list.split)
qed

lemma safe_hd_rep: "safe_hd q = (α, q')  linearize q = linearize q' 
  (case α of None  linearize q = [] | Some a  linearize q  []  a = hd (linearize q))"
  by transfer
    (auto simp add: queue_invariant_def Let_def hd_append split: list.splits elim: safe_hd_t.elims)

fun replace_hd_t :: "'a  'a queue_t  'a queue_t" where
  "replace_hd_t a ([], []) = ([], [])"
| "replace_hd_t a ([], [l]) = ([], [a])"
| "replace_hd_t a ([], l # ls) = (let fs = rev ls in (a # tl fs, [l]))"
| "replace_hd_t a (f # fs, l # ls) = (a # fs, l # ls)"
| "replace_hd_t a (f # fs, []) = undefined"

lift_definition replace_hd :: "'a  'a queue  'a queue" is replace_hd_t
  by (auto simp: queue_invariant_def split: list.splits elim: replace_hd_t.elims)

lemma tl_append: "xs  []  tl xs @ ys = tl (xs @ ys)"
  by simp

lemma replace_hd_rep: "linearize q = f # fs  linearize (replace_hd a q) = a # fs"
proof (transfer fixing: f fs a)
  fix q
  assume "queue_invariant q" and "(case q of (fs, ls)  fs @ rev ls) = f # fs"
  then show "(case replace_hd_t a q of (fs, ls)  fs @ rev ls) = a # fs"
    by (cases "(a, q)" rule: replace_hd_t.cases) (auto simp: queue_invariant_def tl_append)
qed

fun replace_last_t :: "'a  'a queue_t  'a queue_t" where
  "replace_last_t a ([], []) = ([], [])"
| "replace_last_t a (fs, l # ls) = (fs, a # ls)"
| "replace_last_t a (fs, []) = undefined"

lift_definition replace_last :: "'a  'a queue  'a queue" is replace_last_t
  by (auto simp: queue_invariant_def split: list.splits elim: replace_last_t.elims)

lemma replace_last_rep: "linearize q = fs @ [f]  linearize (replace_last a q) = fs @ [a]"
  by transfer (auto simp: queue_invariant_def split: list.splits prod.splits elim!: replace_last_t.elims)

fun tl_queue_t :: "'a queue_t  'a queue_t" where
  "tl_queue_t ([], []) = ([], [])"
| "tl_queue_t ([], [l]) = ([], [])"
| "tl_queue_t ([], l # ls) = (tl (rev ls), [l])"
| "tl_queue_t (a # as, fs) = (as, fs)"

lift_definition tl_queue :: "'a queue  'a queue" is tl_queue_t
  by (auto simp: queue_invariant_def split: list.splits elim!: tl_queue_t.elims)

lemma tl_queue_rep: "¬is_empty q  linearize (tl_queue q) = tl (linearize q)"
  by transfer (auto simp: tl_append split: prod.splits list.splits elim!: tl_queue_t.elims)

lemma length_tl_queue_rep: "¬is_empty q 
  length (linearize (tl_queue q)) < length (linearize q)"
  by transfer (auto split: prod.splits list.splits elim: tl_queue_t.elims)

lemma length_tl_queue_safe_hd:
  assumes "safe_hd q = (Some a, q')"
  shows "length (linearize (tl_queue q')) < length (linearize q)"
  using safe_hd_rep[OF assms]
  by (auto simp add: length_tl_queue_rep is_empty_alt)

function dropWhile_queue :: "('a  bool)  'a queue  'a queue" where
  "dropWhile_queue f q = (case safe_hd q of (None, q')  q'
  | (Some a, q')  if f a then dropWhile_queue f (tl_queue q') else q')"
  by pat_completeness auto
termination
  using length_tl_queue_safe_hd[OF sym]
  by (relation "measure (λ(f, q). length (linearize q))") (fastforce split: prod.splits)+

lemma dropWhile_hd_tl: "xs  [] 
  dropWhile P xs = (if P (hd xs) then dropWhile P (tl xs) else xs)"
  by (cases xs) auto

lemma dropWhile_queue_rep: "linearize (dropWhile_queue f q) = dropWhile f (linearize q)"
  by (induction f q rule: dropWhile_queue.induct)
     (auto simp add: tl_queue_rep dropWhile_hd_tl is_empty_alt
      split: prod.splits option.splits dest: safe_hd_rep)

function takeWhile_queue :: "('a  bool)  'a queue  'a queue" where
  "takeWhile_queue f q = (case safe_hd q of (None, q')  q'
  | (Some a, q')  if f a
    then prepend_queue a (takeWhile_queue f (tl_queue q'))
    else empty_queue)"
  by pat_completeness auto
termination
  using length_tl_queue_safe_hd[OF sym]
  by (relation "measure (λ(f, q). length (linearize q))") (fastforce split: prod.splits)+

lemma takeWhile_hd_tl: "xs  [] 
  takeWhile P xs = (if P (hd xs) then hd xs # takeWhile P (tl xs) else [])"
  by (cases xs) auto

lemma takeWhile_queue_rep: "linearize (takeWhile_queue f q) = takeWhile f (linearize q)"
  by (induction f q rule: takeWhile_queue.induct)
     (auto simp add: prepend_queue_rep tl_queue_rep empty_queue_rep takeWhile_hd_tl is_empty_alt
      split: prod.splits option.splits dest: safe_hd_rep)

function takedropWhile_queue :: "('a  bool)  'a queue  'a queue × 'a list" where
  "takedropWhile_queue f q = (case safe_hd q of (None, q')  (q', [])
  | (Some a, q')  if f a
    then (case takedropWhile_queue f (tl_queue q') of (q'', as)  (q'', a # as))
    else (q', []))"
  by pat_completeness auto
termination
  using length_tl_queue_safe_hd[OF sym]
  by (relation "measure (λ(f, q). length (linearize q))") (fastforce split: prod.splits)+

lemma takedropWhile_queue_fst: "fst (takedropWhile_queue f q) = dropWhile_queue f q"
proof (induction f q rule: takedropWhile_queue.induct)
  case (1 f q)
  then show ?case
    by (simp split: prod.splits) (auto simp add: case_prod_unfold split: option.splits)
qed

lemma takedropWhile_queue_snd: "snd (takedropWhile_queue f q) = takeWhile f (linearize q)"
proof (induction f q rule: takedropWhile_queue.induct)
  case (1 f q)
  then show ?case
    by (simp split: prod.splits)
      (auto simp add: case_prod_unfold tl_queue_rep takeWhile_hd_tl is_empty_alt
        split: option.splits dest: safe_hd_rep)
qed

subsection ‹Optimized data structure for Since›

type_synonym 'a mmsaux = "ts × ts × bool list × bool list ×
  (ts × 'a table) queue × (ts × 'a table) queue ×
  (('a tuple, ts) mapping) × (('a tuple, ts) mapping)"

fun time_mmsaux :: "'a mmsaux  ts" where
  "time_mmsaux aux = (case aux of (nt, _)  nt)"

definition ts_tuple_rel :: "(ts × 'a table) set  (ts × 'a tuple) set" where
  "ts_tuple_rel ys = {(t, as). X. as  X  (t, X)  ys}"

lemma finite_fst_ts_tuple_rel: "finite (fst ` {tas  ts_tuple_rel (set xs). P tas})"
proof -
  have "fst ` {tas  ts_tuple_rel (set xs). P tas}  fst ` ts_tuple_rel (set xs)"
    by auto
  moreover have "  set (map fst xs)"
    by (force simp add: ts_tuple_rel_def)
  finally show ?thesis
    using finite_subset by blast
qed

lemma ts_tuple_rel_ext_Cons: "tas  ts_tuple_rel {(nt, X)} 
  tas  ts_tuple_rel (set ((nt, X) # tass))"
  by (auto simp add: ts_tuple_rel_def)

lemma ts_tuple_rel_ext_Cons': "tas  ts_tuple_rel (set tass) 
  tas  ts_tuple_rel (set ((nt, X) # tass))"
  by (auto simp add: ts_tuple_rel_def)

lemma ts_tuple_rel_intro: "as  X  (t, X)  ys  (t, as)  ts_tuple_rel ys"
  by (auto simp add: ts_tuple_rel_def)

lemma ts_tuple_rel_dest: "(t, as)  ts_tuple_rel ys  X. (t, X)  ys  as  X"
  by (auto simp add: ts_tuple_rel_def)

lemma ts_tuple_rel_Un: "ts_tuple_rel (ys  zs) = ts_tuple_rel ys  ts_tuple_rel zs"
  by (auto simp add: ts_tuple_rel_def)

lemma ts_tuple_rel_ext: "tas  ts_tuple_rel {(nt, X)} 
  tas  ts_tuple_rel (set ((nt, Y  X) # tass))"
proof -
  assume assm: "tas  ts_tuple_rel {(nt, X)}"
  then obtain as where tas_def: "tas = (nt, as)" "as  X"
    by (cases tas) (auto simp add: ts_tuple_rel_def)
  then have "as  Y  X"
    by auto
  then show "tas  ts_tuple_rel (set ((nt, Y  X) # tass))"
    unfolding tas_def(1)
    by (rule ts_tuple_rel_intro) auto
qed

lemma ts_tuple_rel_ext': "tas  ts_tuple_rel (set ((nt, X) # tass)) 
  tas  ts_tuple_rel (set ((nt, X  Y) # tass))"
proof -
  assume assm: "tas  ts_tuple_rel (set ((nt, X) # tass))"
  then have "tas  ts_tuple_rel {(nt, X)}  ts_tuple_rel (set tass)"
    using ts_tuple_rel_Un by force
  then show "tas  ts_tuple_rel (set ((nt, X  Y) # tass))"
  proof
    assume "tas  ts_tuple_rel {(nt, X)}"
    then show ?thesis
      by (auto simp: Un_commute dest!: ts_tuple_rel_ext)
  next
    assume "tas  ts_tuple_rel (set tass)"
    then have "tas  ts_tuple_rel (set ((nt, X  Y) # tass))"
      by (rule ts_tuple_rel_ext_Cons')
    then show ?thesis by simp
  qed
qed

lemma ts_tuple_rel_mono: "ys  zs  ts_tuple_rel ys  ts_tuple_rel zs"
  by (auto simp add: ts_tuple_rel_def)

lemma ts_tuple_rel_filter: "ts_tuple_rel (set (filter (λ(t, X). P t) xs)) =
  {(t, X)  ts_tuple_rel (set xs). P t}"
  by (auto simp add: ts_tuple_rel_def)

lemma ts_tuple_rel_set_filter: "x  ts_tuple_rel (set (filter P xs)) 
  x  ts_tuple_rel (set xs)"
  by (auto simp add: ts_tuple_rel_def)

definition valid_tuple :: "(('a tuple, ts) mapping)  (ts × 'a tuple)  bool" where
  "valid_tuple tuple_since = (λ(t, as). case Mapping.lookup tuple_since as of None  False
  | Some t'  t  t')"

definition safe_max :: "'a :: linorder set  'a option" where
  "safe_max X = (if X = {} then None else Some (Max X))"

lemma safe_max_empty: "safe_max X = None  X = {}"
  by (simp add: safe_max_def)

lemma safe_max_empty_dest: "safe_max X = None  X = {}"
  by (simp add: safe_max_def split: if_splits)

lemma safe_max_Some_intro: "x  X  y. safe_max X = Some y"
  using safe_max_empty by auto

lemma safe_max_Some_dest_in: "finite X  safe_max X = Some x  x  X"
  using Max_in by (auto simp add: safe_max_def split: if_splits)

lemma safe_max_Some_dest_le: "finite X  safe_max X = Some x  y  X  y  x"
  using Max_ge by (auto simp add: safe_max_def split: if_splits)

fun valid_mmsaux :: "args  ts  'a mmsaux  'a Monitor.msaux  bool" where
  "valid_mmsaux args cur (nt, gc, maskL, maskR, data_prev, data_in, tuple_in, tuple_since) ys 
    (args_L args)  (args_R args) 
    maskL = join_mask (args_n args) (args_L args) 
    maskR = join_mask (args_n args) (args_R args) 
    ((t, X)  set ys. table (args_n args) (args_R args) X) 
    table (args_n args) (args_R args) (Mapping.keys tuple_in) 
    table (args_n args) (args_R args) (Mapping.keys tuple_since) 
    (as  (snd ` (set (linearize data_prev))). wf_tuple (args_n args) (args_R args) as) 
    cur = nt 
    ts_tuple_rel (set ys) =
    {tas  ts_tuple_rel (set (linearize data_prev)  set (linearize data_in)).
    valid_tuple tuple_since tas} 
    sorted (map fst (linearize data_prev)) 
    (t  fst ` set (linearize data_prev). t  nt  nt - t < left (args_ivl args)) 
    sorted (map fst (linearize data_in)) 
    (t  fst ` set (linearize data_in). t  nt  nt - t  left (args_ivl args)) 
    (as. Mapping.lookup tuple_in as = safe_max (fst `
    {tas  ts_tuple_rel (set (linearize data_in)). valid_tuple tuple_since tas  as = snd tas})) 
    (as  Mapping.keys tuple_since. case Mapping.lookup tuple_since as of Some t  t  nt)"

lemma Mapping_lookup_filter_keys: "k  Mapping.keys (Mapping.filter f m) 
  Mapping.lookup (Mapping.filter f m) k = Mapping.lookup m k"
  by (metis default_def insert_subset keys_default keys_filter lookup_default lookup_default_filter)

lemma Mapping_filter_keys: "(k  Mapping.keys m. P (Mapping.lookup m k)) 
  (k  Mapping.keys (Mapping.filter f m). P (Mapping.lookup (Mapping.filter f m) k))"
  using Mapping_lookup_filter_keys Mapping.keys_filter by fastforce

lemma Mapping_filter_keys_le: "(x. P x  P' x) 
  (k  Mapping.keys m. P (Mapping.lookup m k))  (k  Mapping.keys m. P' (Mapping.lookup m k))"
  by auto

lemma Mapping_keys_dest: "x  Mapping.keys f  y. Mapping.lookup f x = Some y"
  by (simp add: domD keys_dom_lookup)

lemma Mapping_keys_intro: "Mapping.lookup f x  None  x  Mapping.keys f"
  by (simp add: domIff keys_dom_lookup)

lemma valid_mmsaux_tuple_in_keys: "valid_mmsaux args cur
  (nt, gc, maskL, maskR, data_prev, data_in, tuple_in, tuple_since) ys 
  Mapping.keys tuple_in = snd ` {tas  ts_tuple_rel (set (linearize data_in)).
  valid_tuple tuple_since tas}"
  by (auto intro!: Mapping_keys_intro safe_max_Some_intro
      dest!: Mapping_keys_dest safe_max_Some_dest_in[OF finite_fst_ts_tuple_rel])+

fun init_mmsaux :: "args  'a mmsaux" where
  "init_mmsaux args = (0, 0, join_mask (args_n args) (args_L args),
  join_mask (args_n args) (args_R args), empty_queue, empty_queue, Mapping.empty, Mapping.empty)"

lemma valid_init_mmsaux: "L  R  valid_mmsaux (init_args I n L R b) 0
  (init_mmsaux (init_args I n L R b)) []"
  by (auto simp add: init_args_def empty_queue_rep ts_tuple_rel_def join_mask_def
      Mapping.lookup_empty safe_max_def table_def)

abbreviation "filter_cond X' ts t'  (λas _. ¬ (as  X'  Mapping.lookup ts as = Some t'))"

lemma dropWhile_filter:
  "sorted (map fst xs)  t  fst ` set xs. t  nt 
  dropWhile (λ(t, X). enat (nt - t) > c) xs = filter (λ(t, X). enat (nt - t)  c) xs"
  by (induction xs) (auto 0 3 intro!: filter_id_conv[THEN iffD2, symmetric] elim: order.trans[rotated])

lemma dropWhile_filter':
  fixes nt :: nat
  shows "sorted (map fst xs)  t  fst ` set xs. t  nt 
  dropWhile (λ(t, X). nt - t  c) xs = filter (λ(t, X). nt - t < c) xs"
  by (induction xs) (auto 0 3 intro!: filter_id_conv[THEN iffD2, symmetric] elim: order.trans[rotated])

lemma dropWhile_filter'':
  "sorted xs  t  set xs. t  nt 
  dropWhile (λt. enat (nt - t) > c) xs = filter (λt. enat (nt - t)  c) xs"
  by (induction xs) (auto 0 3 intro!: filter_id_conv[THEN iffD2, symmetric] elim: order.trans[rotated])

lemma takeWhile_filter:
  "sorted (map fst xs)  t  fst ` set xs. t  nt 
  takeWhile (λ(t, X). enat (nt - t) > c) xs = filter (λ(t, X). enat (nt - t) > c) xs"
  by (induction xs) (auto 0 3 simp: less_enat_iff intro!: filter_empty_conv[THEN iffD2, symmetric])

lemma takeWhile_filter':
  fixes nt :: nat
  shows "sorted (map fst xs)  t  fst ` set xs. t  nt 
  takeWhile (λ(t, X). nt - t  c) xs = filter (λ(t, X). nt - t  c) xs"
  by (induction xs) (auto 0 3 simp: less_enat_iff intro!: filter_empty_conv[THEN iffD2, symmetric])

lemma takeWhile_filter'':
  "sorted xs  t  set xs. t  nt 
  takeWhile (λt. enat (nt - t) > c) xs = filter (λt. enat (nt - t) > c) xs"
  by (induction xs) (auto 0 3 simp: less_enat_iff intro!: filter_empty_conv[THEN iffD2, symmetric])

lemma fold_Mapping_filter_None: "Mapping.lookup ts as = None 
  Mapping.lookup (fold (λ(t, X) ts. Mapping.filter
  (filter_cond X ts t) ts) ds ts) as = None"
  by (induction ds arbitrary: ts) (auto simp add: Mapping.lookup_filter)

lemma Mapping_lookup_filter_Some_P: "Mapping.lookup (Mapping.filter P m) k = Some v  P k v"
  by (auto simp add: Mapping.lookup_filter split: option.splits if_splits)

lemma Mapping_lookup_filter_None: "(v. ¬P k v) 
  Mapping.lookup (Mapping.filter P m) k = None"
  by (auto simp add: Mapping.lookup_filter split: option.splits)

lemma Mapping_lookup_filter_Some: "(v. P k v) 
  Mapping.lookup (Mapping.filter P m) k = Mapping.lookup m k"
  by (auto simp add: Mapping.lookup_filter split: option.splits)

lemma Mapping_lookup_filter_not_None: "Mapping.lookup (Mapping.filter P m) k  None 
  Mapping.lookup (Mapping.filter P m) k = Mapping.lookup m k"
  by (auto simp add: Mapping.lookup_filter split: option.splits)

lemma fold_Mapping_filter_Some_None: "Mapping.lookup ts as = Some t 
  as  X  (t, X)  set ds 
  Mapping.lookup (fold (λ(t, X) ts. Mapping.filter (filter_cond X ts t) ts) ds ts) as = None"
proof (induction ds arbitrary: ts)
  case (Cons a ds)
  show ?case
  proof (cases a)
    case (Pair t' X')
    with Cons show ?thesis
      using fold_Mapping_filter_None[of "Mapping.filter (filter_cond X' ts t') ts" as ds]
        Mapping_lookup_filter_not_None[of "filter_cond X' ts t'" ts as]
        fold_Mapping_filter_None[OF Mapping_lookup_filter_None, of _ as ds ts]
      by (cases "Mapping.lookup (Mapping.filter (filter_cond X' ts t') ts) as = None") auto
  qed
qed simp

lemma fold_Mapping_filter_Some_Some: "Mapping.lookup ts as = Some t 
  (X. (t, X)  set ds  as  X) 
  Mapping.lookup (fold (λ(t, X) ts. Mapping.filter (filter_cond X ts t) ts) ds ts) as = Some t"
proof (induction ds arbitrary: ts)
  case (Cons a ds)
  then show ?case
  proof (cases a)
    case (Pair t' X')
    with Cons show ?thesis
      using Mapping_lookup_filter_Some[of "filter_cond X' ts t'" as ts] by auto
  qed
qed simp

fun shift_end :: "args  ts  'a mmsaux  'a mmsaux" where
  "shift_end args nt (t, gc, maskL, maskR, data_prev, data_in, tuple_in, tuple_since) =
    (let I = args_ivl args;
    data_prev' = dropWhile_queue (λ(t, X). enat (nt - t) > right I) data_prev;
    (data_in, discard) = takedropWhile_queue (λ(t, X). enat (nt - t) > right I) data_in;
    tuple_in = fold (λ(t, X) tuple_in. Mapping.filter
      (filter_cond X tuple_in t) tuple_in) discard tuple_in in
    (t, gc, maskL, maskR, data_prev', data_in, tuple_in, tuple_since))"

lemma valid_shift_end_mmsaux_unfolded:
  assumes valid_before: "valid_mmsaux args cur
    (ot, gc, maskL, maskR, data_prev, data_in, tuple_in, tuple_since) auxlist"
  and nt_mono: "nt  cur"
  shows "valid_mmsaux args cur (shift_end args nt
    (ot, gc, maskL, maskR, data_prev, data_in, tuple_in, tuple_since))
    (filter (λ(t, rel). enat (nt - t)  right (args_ivl args)) auxlist)"
proof -
  define I where "I = args_ivl args"
  define data_in' where "data_in' 
    fst (takedropWhile_queue (λ(t, X). enat (nt - t) > right I) data_in)"
  define data_prev' where "data_prev' 
    dropWhile_queue (λ(t, X). enat (nt - t) > right I) data_prev"
  define discard where "discard 
    snd (takedropWhile_queue (λ(t, X). enat (nt - t) > right I) data_in)"
  define tuple_in' where "tuple_in'  fold (λ(t, X) tuple_in. Mapping.filter
    (λas _. ¬(as  X  Mapping.lookup tuple_in as = Some t)) tuple_in) discard tuple_in"
  have tuple_in_Some_None: "as t X. Mapping.lookup tuple_in as = Some t 
    as  X  (t, X)  set discard  Mapping.lookup tuple_in' as = None"
    using fold_Mapping_filter_Some_None unfolding tuple_in'_def by fastforce
  have tuple_in_Some_Some: "as t. Mapping.lookup tuple_in as = Some t 
    (X. (t, X)  set discard  as  X)  Mapping.lookup tuple_in' as = Some t"
    using fold_Mapping_filter_Some_Some unfolding tuple_in'_def by fastforce
  have tuple_in_None_None: "as. Mapping.lookup tuple_in as = None 
    Mapping.lookup tuple_in' as = None"
    using fold_Mapping_filter_None unfolding tuple_in'_def by fastforce
  have tuple_in'_keys: "as. as  Mapping.keys tuple_in'  as  Mapping.keys tuple_in"
    using tuple_in_Some_None tuple_in_Some_Some tuple_in_None_None
    by (fastforce intro: Mapping_keys_intro dest: Mapping_keys_dest)
  have F1: "sorted (map fst (linearize data_in))" "t  fst ` set (linearize data_in). t  nt"
    using valid_before nt_mono by auto
  have F2: "sorted (map fst (linearize data_prev))" "t  fst ` set (linearize data_prev). t  nt"
    using valid_before nt_mono by auto
  have lin_data_in': "linearize data_in' =
    filter (λ(t, X). enat (nt - t)  right I) (linearize data_in)"
    unfolding data_in'_def[unfolded takedropWhile_queue_fst] dropWhile_queue_rep
      dropWhile_filter[OF F1] ..
  then have set_lin_data_in': "set (linearize data_in')  set (linearize data_in)"
    by auto
  have "sorted (map fst (linearize data_in))"
    using valid_before by auto
  then have sorted_lin_data_in': "sorted (map fst (linearize data_in'))"
    unfolding lin_data_in' using sorted_filter by auto
  have discard_alt: "discard = filter (λ(t, X). enat (nt - t) > right I) (linearize data_in)"
    unfolding discard_def[unfolded takedropWhile_queue_snd] takeWhile_filter[OF F1] ..
  have lin_data_prev': "linearize data_prev' =
    filter (λ(t, X). enat (nt - t)  right I) (linearize data_prev)"
    unfolding data_prev'_def[unfolded takedropWhile_queue_fst] dropWhile_queue_rep
      dropWhile_filter[OF F2] ..
  have "sorted (map fst (linearize data_prev))"
    using valid_before by auto
  then have sorted_lin_data_prev': "sorted (map fst (linearize data_prev'))"
    unfolding lin_data_prev' using sorted_filter by auto
  have lookup_tuple_in': "as. Mapping.lookup tuple_in' as = safe_max (fst `
    {tas  ts_tuple_rel (set (linearize data_in')). valid_tuple tuple_since tas  as = snd tas})"
  proof -
    fix as
    show "Mapping.lookup tuple_in' as = safe_max (fst `
    {tas  ts_tuple_rel (set (linearize data_in')). valid_tuple tuple_since tas  as = snd tas})"
    proof (cases "Mapping.lookup tuple_in as")
      case None
      then have "{tas  ts_tuple_rel (set (linearize data_in)).
        valid_tuple tuple_since tas  as = snd tas} = {}"
        using valid_before by (auto dest!: safe_max_empty_dest)
      then have "{tas  ts_tuple_rel (set (linearize data_in')).
        valid_tuple tuple_since tas  as = snd tas} = {}"
        using ts_tuple_rel_mono[OF set_lin_data_in'] by auto
      then show ?thesis
        unfolding tuple_in_None_None[OF None] using iffD2[OF safe_max_empty, symmetric] by blast
    next
      case (Some t)
      show ?thesis
      proof (cases "X. (t, X)  set discard  as  X")
        case True
        then obtain X where X_def: "(t, X)  set discard" "as  X"
          by auto
        have "enat (nt - t) > right I"
          using X_def(1) unfolding discard_alt by simp
        moreover have "t'. (t', as)  ts_tuple_rel (set (linearize data_in)) 
          valid_tuple tuple_since (t', as)  t'  t"
          using valid_before Some safe_max_Some_dest_le[OF finite_fst_ts_tuple_rel]
          by (fastforce simp add: image_iff)
        ultimately have "{tas  ts_tuple_rel (set (linearize data_in')).
          valid_tuple tuple_since tas  as = snd tas} = {}"
          unfolding lin_data_in' using ts_tuple_rel_set_filter
          by (auto simp add: ts_tuple_rel_def)
             (meson diff_le_mono2 enat_ord_simps(2) leD le_less_trans)
        then show ?thesis
          unfolding tuple_in_Some_None[OF Some X_def(2,1)]
          using iffD2[OF safe_max_empty, symmetric] by blast
      next
        case False
        then have lookup_Some: "Mapping.lookup tuple_in' as = Some t"
          using tuple_in_Some_Some[OF Some] by auto
        have t_as: "(t, as)  ts_tuple_rel (set (linearize data_in))"
          "valid_tuple tuple_since (t, as)"
          using valid_before Some by (auto dest: safe_max_Some_dest_in[OF finite_fst_ts_tuple_rel])
        then obtain X where X_def: "as  X" "(t, X)  set (linearize data_in)"
          by (auto simp add: ts_tuple_rel_def)
        have "(t, X)  set (linearize data_in')"
          using X_def False unfolding discard_alt lin_data_in' by auto
        then have t_in_fst: "t  fst ` {tas  ts_tuple_rel (set (linearize data_in')).
          valid_tuple tuple_since tas  as = snd tas}"
          using t_as(2) X_def(1) by (auto simp add: ts_tuple_rel_def image_iff)
        have "t'. (t', as)  ts_tuple_rel (set (linearize data_in)) 
          valid_tuple tuple_since (t', as)  t'  t"
          using valid_before Some safe_max_Some_dest_le[OF finite_fst_ts_tuple_rel]
          by (fastforce simp add: image_iff)
        then have "Max (fst ` {tas  ts_tuple_rel (set (linearize data_in')).
          valid_tuple tuple_since tas  as = snd tas}) = t"
          using Max_eqI[OF finite_fst_ts_tuple_rel, OF _ t_in_fst]
            ts_tuple_rel_mono[OF set_lin_data_in'] by fastforce
        then show ?thesis
          unfolding lookup_Some using t_in_fst by (auto simp add: safe_max_def)
      qed
    qed
  qed
  have table_in: "table (args_n args) (args_R args) (Mapping.keys tuple_in')"
    using tuple_in'_keys valid_before by (auto simp add: table_def)
  have "ts_tuple_rel (set auxlist) =
    {as  ts_tuple_rel (set (linearize data_prev)  set (linearize data_in)).
    valid_tuple tuple_since as}"
    using valid_before by auto
  then have "ts_tuple_rel (set (filter (λ(t, rel). enat (nt - t)  right I) auxlist)) =
    {as  ts_tuple_rel (set (linearize data_prev')  set (linearize data_in')).
    valid_tuple tuple_since as}"
    unfolding lin_data_prev' lin_data_in' ts_tuple_rel_Un ts_tuple_rel_filter by auto
  then show ?thesis
    using data_prev'_def data_in'_def tuple_in'_def discard_def valid_before nt_mono
      sorted_lin_data_prev' sorted_lin_data_in' lin_data_prev' lin_data_in' lookup_tuple_in'
      table_in unfolding I_def
    by (auto simp only: valid_mmsaux.simps shift_end.simps Let_def split: prod.splits) auto
      (* takes long *)
qed

lemma valid_shift_end_mmsaux: "valid_mmsaux args cur aux auxlist  nt  cur 
  valid_mmsaux args cur (shift_end args nt aux)
  (filter (λ(t, rel). enat (nt - t)  right (args_ivl args)) auxlist)"
  using valid_shift_end_mmsaux_unfolded by (cases aux) fast

setup_lifting type_definition_mapping

lift_definition upd_set :: "('a, 'b) mapping  ('a  'b)  'a set  ('a, 'b) mapping" is
  "λm f X a. if a  X then Some (f a) else m a" .

lemma Mapping_lookup_upd_set: "Mapping.lookup (upd_set m f X) a =
  (if a  X then Some (f a) else Mapping.lookup m a)"
  by (simp add: Mapping.lookup.rep_eq upd_set.rep_eq)

lemma Mapping_upd_set_keys: "Mapping.keys (upd_set m f X) = Mapping.keys m  X"
  by (auto simp add: Mapping_lookup_upd_set dest!: Mapping_keys_dest intro: Mapping_keys_intro)

lift_definition upd_keys_on :: "('a, 'b) mapping  ('a  'b  'b)  'a set 
  ('a, 'b) mapping" is
  "λm f X a. case Mapping.lookup m a of Some b  Some (if a  X then f a b else b)
  | None  None" .

lemma Mapping_lookup_upd_keys_on: "Mapping.lookup (upd_keys_on m f X) a =
  (case Mapping.lookup m a of Some b  Some (if a  X then f a b else b) | None  None)"
  by (simp add: Mapping.lookup.rep_eq upd_keys_on.rep_eq)

lemma Mapping_upd_keys_sub: "Mapping.keys (upd_keys_on m f X) = Mapping.keys m"
  by (auto simp add: Mapping_lookup_upd_keys_on dest!: Mapping_keys_dest intro: Mapping_keys_intro
      split: option.splits)

lemma fold_append_queue_rep: "linearize (fold (λx q. append_queue x q) xs q) = linearize q @ xs"
  by (induction xs arbitrary: q) (auto simp add: append_queue_rep)

lemma Max_Un_absorb:
  assumes "finite X" "X  {}" "finite Y" "(x y. y  Y  x  X  y  x)"
  shows "Max (X  Y) = Max X"
proof -
  have Max_X_in_X: "Max X  X"
    using Max_in[OF assms(1,2)] .
  have Max_X_in_XY: "Max X  X  Y"
    using Max_in[OF assms(1,2)] by auto
  have fin: "finite (X  Y)"
    using assms(1,3) by auto
  have Y_le_Max_X: "y. y  Y  y  Max X"
    using assms(4)[OF _ Max_X_in_X] .
  have XY_le_Max_X: "y. y  X  Y  y  Max X"
    using Max_ge[OF assms(1)] Y_le_Max_X by auto
  show ?thesis
    using Max_eqI[OF fin XY_le_Max_X Max_X_in_XY] by auto
qed

lemma Mapping_lookup_fold_upd_set_idle: "{(t, X)  set xs. as  Z X t} = {} 
  Mapping.lookup (fold (λ(t, X) m. upd_set m (λ_. t) (Z X t)) xs m) as = Mapping.lookup m as"
proof (induction xs arbitrary: m)
  case Nil
  then show ?case by simp
next
  case (Cons x xs)
  obtain x1 x2 where "x = (x1, x2)" by (cases x)
  have "Mapping.lookup (fold (λ(t, X) m. upd_set m (λ_. t) (Z X t)) xs (upd_set m (λ_. x1) (Z x2 x1))) as =
    Mapping.lookup (upd_set m (λ_. x1) (Z x2 x1)) as"
    using Cons by auto
  also have "Mapping.lookup (upd_set m (λ_. x1) (Z x2 x1)) as = Mapping.lookup m as"
    using Cons.prems by (auto simp: x = (x1, x2) Mapping_lookup_upd_set)
  finally show ?case by (simp add: x = (x1, x2))
qed

lemma Mapping_lookup_fold_upd_set_max: "{(t, X)  set xs. as  Z X t}  {} 
  sorted (map fst xs) 
  Mapping.lookup (fold (λ(t, X) m. upd_set m (λ_. t) (Z X t)) xs m) as =
  Some (Max (fst ` {(t, X)  set xs. as  Z X t}))"
proof (induction xs arbitrary: m)
  case (Cons x xs)
  obtain t X where tX_def: "x = (t, X)"
    by (cases x) auto
  have set_fst_eq: "(fst ` {(t, X). (t, X)  set (x # xs)  as  Z X t}) =
    ((fst ` {(t, X). (t, X)  set xs  as  Z X t}) 
    (if as  Z X t then {t} else {}))"
    using image_iff by (fastforce simp add: tX_def split: if_splits)
  show ?case
  proof (cases "{(t, X). (t, X)  set xs  as  Z X t}  {}")
    case True
    have "{(t, X). (t, X)  set xs  as  Z X t}  set xs"
      by auto
    then have fin: "finite (fst ` {(t, X). (t, X)  set xs  as  Z X t})"
      by (simp add: finite_subset)
    have "Max (insert t (fst ` {(t, X). (t, X)  set xs  as  Z X t})) =
      Max (fst ` {(t, X). (t, X)  set xs  as  Z X t})"
      using Max_Un_absorb[OF fin, of "{t}"] True Cons(3) tX_def by auto
    then show ?thesis
      using Cons True unfolding set_fst_eq by auto
  next
    case False
    then have empty: "{(t, X). (t, X)  set xs  as  Z X t} = {}"
      by auto
    then have "as  Z X t"
      using Cons(2) set_fst_eq by fastforce
    then show ?thesis
      using Mapping_lookup_fold_upd_set_idle[OF empty] unfolding set_fst_eq empty
      by (auto simp add: Mapping_lookup_upd_set tX_def)
  qed
qed simp

fun add_new_ts_mmsaux' :: "args  ts  'a mmsaux  'a mmsaux" where
  "add_new_ts_mmsaux' args nt (t, gc, maskL, maskR, data_prev, data_in, tuple_in, tuple_since) =
    (let I = args_ivl args;
    (data_prev, move) = takedropWhile_queue (λ(t, X). nt - t  left I) data_prev;
    data_in = fold (λ(t, X) data_in. append_queue (t, X) data_in) move data_in;
    tuple_in = fold (λ(t, X) tuple_in. upd_set tuple_in (λ_. t)
      {as  X. valid_tuple tuple_since (t, as)}) move tuple_in in
    (nt, gc, maskL, maskR, data_prev, data_in, tuple_in, tuple_since))"

lemma Mapping_keys_fold_upd_set: "k  Mapping.keys (fold (λ(t, X) m. upd_set m (λ_. t) (Z t X))
  xs m)  k  Mapping.keys m  ((t, X)  set xs. k  Z t X)"
  by (induction xs arbitrary: m) (fastforce simp add: Mapping_upd_set_keys)+

lemma valid_add_new_ts_mmsaux'_unfolded:
  assumes valid_before: "valid_mmsaux args cur
    (ot, gc, maskL, maskR, data_prev, data_in, tuple_in, tuple_since) auxlist"
  and nt_mono: "nt  cur"
  shows "valid_mmsaux args nt (add_new_ts_mmsaux' args nt
    (ot, gc, maskL, maskR, data_prev, data_in, tuple_in, tuple_since)) auxlist"
proof -
  define I where "I = args_ivl args"
  define n where "n = args_n args"
  define L where "L = args_L args"
  define R where "R = args_R args"
  define pos where "pos = args_pos args"
  define data_prev' where "data_prev'  dropWhile_queue (λ(t, X). nt - t  left I) data_prev"
  define move where "move  takeWhile (λ(t, X). nt - t  left I) (linearize data_prev)"
  define data_in' where "data_in'  fold (λ(t, X) data_in. append_queue (t, X) data_in)
    move data_in"
  define tuple_in' where "tuple_in'  fold (λ(t, X) tuple_in. upd_set tuple_in (λ_. t)
      {as  X. valid_tuple tuple_since (t, as)}) move tuple_in"
  have tuple_in'_keys: "as. as  Mapping.keys tuple_in'  as  Mapping.keys tuple_in 
    ((t, X)set move. as  {as  X. valid_tuple tuple_since (t, as)})"
    using Mapping_keys_fold_upd_set[of _ "λt X. {as  X. valid_tuple tuple_since (t, as)}"]
    by (auto simp add: tuple_in'_def)
  have F1: "sorted (map fst (linearize data_in))" "t  fst ` set (linearize data_in). t  nt"
    "t  fst ` set (linearize data_in). t  ot  ot - t  left I"
    using valid_before nt_mono unfolding I_def by auto
  have F2: "sorted (map fst (linearize data_prev))" "t  fst ` set (linearize data_prev). t  nt"
    "t  fst ` set (linearize data_prev). t  ot  ot - t < left I"
    using valid_before nt_mono unfolding I_def by auto
  have lin_data_prev': "linearize data_prev' =
    filter (λ(t, X). nt - t < left I) (linearize data_prev)"
    unfolding data_prev'_def dropWhile_queue_rep dropWhile_filter'[OF F2(1,2)] ..
  have move_filter: "move = filter (λ(t, X). nt - t  left I) (linearize data_prev)"
    unfolding move_def takeWhile_filter'[OF F2(1,2)] ..
  then have sorted_move: "sorted (map fst move)"
    using sorted_filter F2 by auto
  have "tfst ` set move. t  ot  ot - t < left I"
    using move_filter F2(3) set_filter by auto
  then have fst_set_before: "tfst ` set (linearize data_in). t'fst ` set move. t  t'"
    using F1(3) by fastforce
  then have fst_ts_tuple_rel_before: "tfst ` ts_tuple_rel (set (linearize data_in)).
    t'fst ` ts_tuple_rel (set move). t  t'"
    by (fastforce simp add: ts_tuple_rel_def)
  have sorted_lin_data_prev': "sorted (map fst (linearize data_prev'))"
    unfolding lin_data_prev' using sorted_filter F2 by auto
  have lin_data_in': "linearize data_in' = linearize data_in @ move"
    unfolding data_in'_def using fold_append_queue_rep by fastforce
  have sorted_lin_data_in': "sorted (map fst (linearize data_in'))"
    unfolding lin_data_in' using F1(1) sorted_move fst_set_before by (simp add: sorted_append)
  have set_lin_prev'_in': "set (linearize data_prev')  set (linearize data_in') =
    set (linearize data_prev)  set (linearize data_in)"
    using lin_data_prev' lin_data_in' move_filter by auto
  have ts_tuple_rel': "ts_tuple_rel (set auxlist) =
    {tas  ts_tuple_rel (set (linearize data_prev')  set (linearize data_in')).
    valid_tuple tuple_since tas}"
    unfolding set_lin_prev'_in' using valid_before by auto
  have lookup': "as. Mapping.lookup tuple_in' as = safe_max (fst `
    {tas  ts_tuple_rel (set (linearize data_in')).
    valid_tuple tuple_since tas  as = snd tas})"
  proof -
    fix as
    show "Mapping.lookup tuple_in' as = safe_max (fst `
      {tas  ts_tuple_rel (set (linearize data_in')).
      valid_tuple tuple_since tas  as = snd tas})"
    proof (cases "{(t, X)  set move. as  X  valid_tuple tuple_since (t, as)} = {}")
      case True
      have move_absorb: "{tas  ts_tuple_rel (set (linearize data_in)).
        valid_tuple tuple_since tas  as = snd tas} =
        {tas  ts_tuple_rel (set (linearize data_in @ move)).
        valid_tuple tuple_since tas  as = snd tas}"
        using True by (auto simp add: ts_tuple_rel_def)
      have "Mapping.lookup tuple_in as =
        safe_max (fst ` {tas  ts_tuple_rel (set (linearize data_in)).
        valid_tuple tuple_since tas  as = snd tas})"
        using valid_before by auto
      then have "Mapping.lookup tuple_in as =
        safe_max (fst ` {tas  ts_tuple_rel (set (linearize data_in')).
        valid_tuple tuple_since tas  as = snd tas})"
        unfolding lin_data_in' move_absorb .
      then show ?thesis
        using Mapping_lookup_fold_upd_set_idle[of "move" as
          "λX t. {as  X. valid_tuple tuple_since (t, as)}"] True
        unfolding tuple_in'_def by auto
    next
      case False
      have split: "fst ` {tas  ts_tuple_rel (set (linearize data_in')).
        valid_tuple tuple_since tas  as = snd tas} =
        fst ` {tas  ts_tuple_rel (set move). valid_tuple tuple_since tas  as = snd tas} 
        fst ` {tas  ts_tuple_rel (set (linearize data_in)).
        valid_tuple tuple_since tas  as = snd tas}"
        unfolding lin_data_in' set_append ts_tuple_rel_Un by auto
      have max_eq: "Max (fst ` {tas  ts_tuple_rel (set move).
        valid_tuple tuple_since tas  as = snd tas}) =
        Max (fst ` {tas  ts_tuple_rel (set (linearize data_in')).
        valid_tuple tuple_since tas  as = snd tas})"
        unfolding split using False fst_ts_tuple_rel_before
        by (fastforce simp add: ts_tuple_rel_def
            intro!: Max_Un_absorb[OF finite_fst_ts_tuple_rel _ finite_fst_ts_tuple_rel, symmetric])
      have "fst ` {(t, X). (t, X)  set move  as  {as  X. valid_tuple tuple_since (t, as)}} =
        fst ` {tas  ts_tuple_rel (set move). valid_tuple tuple_since tas  as = snd tas}"
        by (auto simp add: ts_tuple_rel_def image_iff)
      then have "Mapping.lookup tuple_in' as = Some (Max (fst ` {tas  ts_tuple_rel (set move).
        valid_tuple tuple_since tas  as = snd tas}))"
        using Mapping_lookup_fold_upd_set_max[of "move" as
          "λX t. {as  X. valid_tuple tuple_since (t, as)}", OF _ sorted_move] False
        unfolding tuple_in'_def by (auto simp add: ts_tuple_rel_def)
      then show ?thesis
        unfolding max_eq using False
        by (auto simp add: safe_max_def lin_data_in' ts_tuple_rel_def)
    qed
  qed
  have table_in': "table n R (Mapping.keys tuple_in')"
  proof -
    {
      fix as
      assume assm: "as  Mapping.keys tuple_in'"
      have "wf_tuple n R as"
        using tuple_in'_keys[OF assm]
      proof (rule disjE)
        assume "as  Mapping.keys tuple_in"
        then show "wf_tuple n R as"
          using valid_before by (auto simp add: table_def n_def R_def)
      next
        assume "(t, X)set move. as  {as  X. valid_tuple tuple_since (t, as)}"
        then obtain t X where tX_def: "(t, X)  set move" "as  X"
          by auto
        then have "as  (snd ` set (linearize data_prev))"
          unfolding move_def using set_takeWhileD by force
        then show "wf_tuple n R as"
          using valid_before by (auto simp add: n_def R_def)
      qed
    }
    then show ?thesis
      by (auto simp add: table_def)
  qed
  have data_prev'_move: "(data_prev', move) =
    takedropWhile_queue (λ(t, X). nt - t  left I) data_prev"
    using takedropWhile_queue_fst takedropWhile_queue_snd data_prev'_def move_def
    by (metis surjective_pairing)
  moreover have "valid_mmsaux args nt (nt, gc, maskL, maskR, data_prev', data_in',
    tuple_in', tuple_since) auxlist"
    using lin_data_prev' sorted_lin_data_prev' lin_data_in' move_filter sorted_lin_data_in'
      nt_mono valid_before ts_tuple_rel' lookup' table_in' unfolding I_def
    by (auto simp only: valid_mmsaux.simps Let_def n_def R_def split: option.splits) auto
      (* takes long *)
  ultimately show ?thesis
    by (auto simp only: add_new_ts_mmsaux'.simps Let_def data_in'_def tuple_in'_def I_def
        split: prod.splits)
qed

lemma valid_add_new_ts_mmsaux': "valid_mmsaux args cur aux auxlist  nt  cur 
  valid_mmsaux args nt (add_new_ts_mmsaux' args nt aux) auxlist"
  using valid_add_new_ts_mmsaux'_unfolded by (cases aux) fast

definition add_new_ts_mmsaux :: "args  ts  'a mmsaux  'a mmsaux" where
  "add_new_ts_mmsaux args nt aux = add_new_ts_mmsaux' args nt (shift_end args nt aux)"

lemma valid_add_new_ts_mmsaux:
  assumes "valid_mmsaux args cur aux auxlist" "nt  cur"
  shows "valid_mmsaux args nt (add_new_ts_mmsaux args nt aux)
    (filter (λ(t, rel). enat (nt - t)  right (args_ivl args)) auxlist)"
  using valid_add_new_ts_mmsaux'[OF valid_shift_end_mmsaux[OF assms] assms(2)]
  unfolding add_new_ts_mmsaux_def .

fun join_mmsaux :: "args  'a table  'a mmsaux  'a mmsaux" where
  "join_mmsaux args X (t, gc, maskL, maskR, data_prev, data_in, tuple_in, tuple_since) =
    (let pos = args_pos args in
    (if maskL = maskR then
      (let tuple_in = Mapping.filter (join_filter_cond pos X) tuple_in;
      tuple_since = Mapping.filter (join_filter_cond pos X) tuple_since in
      (t, gc, maskL, maskR, data_prev, data_in, tuple_in, tuple_since))
    else if (i  set maskL. ¬i) then
      (let nones = replicate (length maskL) None;
      take_all = (pos  nones  X);
      tuple_in = (if take_all then tuple_in else Mapping.empty);
      tuple_since = (if take_all then tuple_since else Mapping.empty) in
      (t, gc, maskL, maskR, data_prev, data_in, tuple_in, tuple_since))
    else
      (let tuple_in = Mapping.filter (λas _. proj_tuple_in_join pos maskL as X) tuple_in;
      tuple_since = Mapping.filter (λas _. proj_tuple_in_join pos maskL as X) tuple_since in
      (t, gc, maskL, maskR, data_prev, data_in, tuple_in, tuple_since))))"

fun join_mmsaux_abs :: "args  'a table  'a mmsaux  'a mmsaux" where
  "join_mmsaux_abs args X (t, gc, maskL, maskR, data_prev, data_in, tuple_in, tuple_since) =
    (let pos = args_pos args in
    (let tuple_in = Mapping.filter (λas _. proj_tuple_in_join pos maskL as X) tuple_in;
    tuple_since = Mapping.filter (λas _. proj_tuple_in_join pos maskL as X) tuple_since in
    (t, gc, maskL, maskR, data_prev, data_in, tuple_in, tuple_since)))"

lemma Mapping_filter_cong:
  assumes cong: "(k v. k  Mapping.keys m  f k v = f' k v)"
  shows "Mapping.filter f m = Mapping.filter f' m"
proof -
  have "k. Mapping.lookup (Mapping.filter f m) k = Mapping.lookup (Mapping.filter f' m) k"
    using cong
    by (fastforce simp add: Mapping.lookup_filter intro: Mapping_keys_intro split: option.splits)
  then show ?thesis
    by (simp add: mapping_eqI)
qed

lemma join_mmsaux_abs_eq:
  assumes valid_before: "valid_mmsaux args cur
    (nt, gc, maskL, maskR, data_prev, data_in, tuple_in, tuple_since) auxlist"
  and table_left: "table (args_n args) (args_L args) X"
  shows "join_mmsaux args X (nt, gc, maskL, maskR, data_prev, data_in, tuple_in, tuple_since) =
    join_mmsaux_abs args X (nt, gc, maskL, maskR, data_prev, data_in, tuple_in, tuple_since)"
proof (cases "maskL = maskR")
  case True
  define n where "n = args_n args"
  define L where "L = args_L args"
  define pos where "pos = args_pos args"
  have keys_wf_in: "as. as  Mapping.keys tuple_in  wf_tuple n L as"
    using wf_tuple_change_base valid_before True by (fastforce simp add: table_def n_def L_def)
  have cong_in: "as n. as  Mapping.keys tuple_in 
    proj_tuple_in_join pos maskL as X  join_cond pos X as"
    using proj_tuple_in_join_mask_idle[OF keys_wf_in] valid_before
    by (auto simp only: valid_mmsaux.simps n_def L_def pos_def)
  have keys_wf_since: "as. as  Mapping.keys tuple_since  wf_tuple n L as"
    using wf_tuple_change_base valid_before True by (fastforce simp add: table_def n_def L_def)
  have cong_since: "as n. as  Mapping.keys tuple_since 
    proj_tuple_in_join pos maskL as X  join_cond pos X as"
    using proj_tuple_in_join_mask_idle[OF keys_wf_since] valid_before
    by (auto simp only: valid_mmsaux.simps n_def L_def pos_def)
  show ?thesis
    using True Mapping_filter_cong[OF cong_in, of tuple_in "λk _. k"]
      Mapping_filter_cong[OF cong_since, of tuple_since "λk _. k"]
    by (auto simp add: pos_def)
next
  case False
  define n where "n = args_n args"
  define L where "L = args_L args"
  define R where "R = args_R args"
  define pos where "pos = args_pos args"
  from False show ?thesis
  proof (cases "i  set maskL. ¬i")
    case True
    have length_maskL: "length maskL = n"
      using valid_before by (auto simp add: join_mask_def n_def)
    have proj_rep: "as. wf_tuple n R as  proj_tuple maskL as = replicate (length maskL) None"
      using True proj_tuple_replicate by (force simp add: length_maskL wf_tuple_def)
    have keys_wf_in: "as. as  Mapping.keys tuple_in  wf_tuple n R as"
      using valid_before by (auto simp add: table_def n_def R_def)
    have keys_wf_since: "as. as  Mapping.keys tuple_since  wf_tuple n R as"
      using valid_before by (auto simp add: table_def n_def R_def)
    have "as. Mapping.lookup (Mapping.filter (λas _. proj_tuple_in_join pos maskL as X)
      tuple_in) as = Mapping.lookup (if (pos  replicate (length maskL) None  X)
      then tuple_in else Mapping.empty) as"
      using proj_rep[OF keys_wf_in]
      by (auto simp add: Mapping.lookup_filter Mapping.lookup_empty proj_tuple_in_join_def
          Mapping_keys_intro split: option.splits)
    moreover have "as. Mapping.lookup (Mapping.filter (λas _. proj_tuple_in_join pos maskL as X)
      tuple_since) as = Mapping.lookup (if (pos  replicate (length maskL) None  X)
      then tuple_since else Mapping.empty) as"
      using proj_rep[OF keys_wf_since]
      by (auto simp add: Mapping.lookup_filter Mapping.lookup_empty proj_tuple_in_join_def
          Mapping_keys_intro split: option.splits)
    ultimately show ?thesis
      using False True by (auto simp add: mapping_eqI Let_def pos_def)
  qed (auto simp add: Let_def)
qed

lemma valid_join_mmsaux_unfolded:
  assumes valid_before: "valid_mmsaux args cur
    (nt, gc, maskL, maskR, data_prev, data_in, tuple_in, tuple_since) auxlist"
  and table_left': "table (args_n args) (args_L args) X"
  shows "valid_mmsaux args cur
    (join_mmsaux args X (nt, gc, maskL, maskR, data_prev, data_in, tuple_in, tuple_since))
    (map (λ(t, rel). (t, join rel (args_pos args) X)) auxlist)"
proof -
  define n where "n = args_n args"
  define L where "L = args_L args"
  define R where "R = args_R args"
  define pos where "pos = args_pos args"
  note table_left = table_left'[unfolded n_def[symmetric] L_def[symmetric]]
  define tuple_in' where "tuple_in' 
    Mapping.filter (λas _. proj_tuple_in_join pos maskL as X) tuple_in"
  define tuple_since' where "tuple_since' 
    Mapping.filter (λas _. proj_tuple_in_join pos maskL as X) tuple_since"
  have tuple_in_None_None: "as. Mapping.lookup tuple_in as = None 
    Mapping.lookup tuple_in' as = None"
    unfolding tuple_in'_def using Mapping_lookup_filter_not_None by fastforce
  have tuple_in'_keys: "as. as  Mapping.keys tuple_in'  as  Mapping.keys tuple_in"
    using tuple_in_None_None
    by (fastforce intro: Mapping_keys_intro dest: Mapping_keys_dest)
  have tuple_since_None_None: "as. Mapping.lookup tuple_since as = None 
    Mapping.lookup tuple_since' as = None"
    unfolding tuple_since'_def using Mapping_lookup_filter_not_None by fastforce
  have tuple_since'_keys: "as. as  Mapping.keys tuple_since'  as  Mapping.keys tuple_since"
    using tuple_since_None_None
    by (fastforce intro: Mapping_keys_intro dest: Mapping_keys_dest)
  have ts_tuple_rel': "ts_tuple_rel (set (map (λ(t, rel). (t, join rel pos X)) auxlist)) =
    {tas  ts_tuple_rel (set (linearize data_prev)  set (linearize data_in)).
    valid_tuple tuple_since' tas}"
  proof (rule set_eqI, rule iffI)
    fix tas
    assume assm: "tas  ts_tuple_rel (set (map (λ(t, rel). (t, join rel pos X)) auxlist))"
    then obtain t as Z where tas_def: "tas = (t, as)" "as  join Z pos X" "(t, Z)  set auxlist"
      "(t, join Z pos X)  set (map (λ(t, rel). (t, join rel pos X)) auxlist)"
      by (fastforce simp add: ts_tuple_rel_def)
    from tas_def(3) have table_Z: "table n R Z"
      using valid_before by (auto simp add: n_def R_def)
    have proj: "as  Z" "proj_tuple_in_join pos maskL as X"
      using tas_def(2) join_sub[OF _ table_left table_Z] valid_before
      by (auto simp add: n_def L_def R_def pos_def)
    then have "(t, as)  ts_tuple_rel (set (auxlist))"
      using tas_def(3) by (auto simp add: ts_tuple_rel_def)
    then have tas_in: "(t, as)  ts_tuple_rel
      (set (linearize data_prev)  set (linearize data_in))" "valid_tuple tuple_since (t, as)"
      using valid_before by auto
    then obtain t' where t'_def: "Mapping.lookup tuple_since as = Some t'" "t  t'"
      by (auto simp add: valid_tuple_def split: option.splits)
    then have valid_tuple_since': "valid_tuple tuple_since' (t, as)"
      using proj(2)
      by (auto simp add: tuple_since'_def Mapping_lookup_filter_Some valid_tuple_def)
    show "tas  {tas  ts_tuple_rel (set (linearize data_prev)  set (linearize data_in)).
      valid_tuple tuple_since' tas}"
      using tas_in valid_tuple_since' unfolding tas_def(1)[symmetric] by auto
  next
    fix tas
    assume assm: "tas  {tas  ts_tuple_rel
      (set (linearize data_prev)  set (linearize data_in)). valid_tuple tuple_since' tas}"
    then obtain t as where tas_def: "tas = (t, as)" "valid_tuple tuple_since' (t, as)"
      by (auto simp add: ts_tuple_rel_def)
    from tas_def(2) have "valid_tuple tuple_since (t, as)"
      unfolding tuple_since'_def using Mapping_lookup_filter_not_None
      by (force simp add: valid_tuple_def split: option.splits)
    then have "(t, as)  ts_tuple_rel (set auxlist)"
      using valid_before assm tas_def(1) by auto
    then obtain Z where Z_def: "as  Z" "(t, Z)  set auxlist"
      by (auto simp add: ts_tuple_rel_def)
    then have table_Z: "table n R Z"
      using valid_before by (auto simp add: n_def R_def)
    from tas_def(2) have "proj_tuple_in_join pos maskL as X"
      unfolding tuple_since'_def using Mapping_lookup_filter_Some_P
      by (fastforce simp add: valid_tuple_def split: option.splits)
    then have as_in_join: "as  join Z pos X"
      using join_sub[OF _ table_left table_Z] Z_def(1) valid_before
      by (auto simp add: n_def L_def R_def pos_def)
    then show "tas  ts_tuple_rel (set (map (λ(t, rel). (t, join rel pos X)) auxlist))"
      using Z_def unfolding tas_def(1) by (auto simp add: ts_tuple_rel_def)
  qed
  have lookup_tuple_in': "as. Mapping.lookup tuple_in' as = safe_max (fst `
    {tas  ts_tuple_rel (set (linearize data_in)). valid_tuple tuple_since' tas  as = snd tas})"
  proof -
    fix as
    show "Mapping.lookup tuple_in' as = safe_max (fst `
    {tas  ts_tuple_rel (set (linearize data_in)). valid_tuple tuple_since' tas  as = snd tas})"
    proof (cases "Mapping.lookup tuple_in as")
      case None
      then have "{tas  ts_tuple_rel (set (linearize data_in)).
        valid_tuple tuple_since tas  as = snd tas} = {}"
        using valid_before by (auto dest!: safe_max_empty_dest)
      then have "{tas  ts_tuple_rel (set (linearize data_in)).
        valid_tuple tuple_since' tas  as = snd tas} = {}"
        using Mapping_lookup_filter_not_None
        by (fastforce simp add: valid_tuple_def tuple_since'_def split: option.splits)
      then show ?thesis
        unfolding tuple_in_None_None[OF None] using iffD2[OF safe_max_empty, symmetric] by blast
    next
      case (Some t)
      show ?thesis
      proof (cases "proj_tuple_in_join pos maskL as X")
        case True
        then have lookup_tuple_in': "Mapping.lookup tuple_in' as = Some t"
          using Some unfolding tuple_in'_def by (simp add: Mapping_lookup_filter_Some)
        have "(t, as)  ts_tuple_rel (set (linearize data_in))" "valid_tuple tuple_since (t, as)"
          using valid_before Some by (auto dest: safe_max_Some_dest_in[OF finite_fst_ts_tuple_rel])
        then have t_in_fst: "t  fst ` {tas  ts_tuple_rel (set (linearize data_in)).
          valid_tuple tuple_since' tas  as = snd tas}"
          using True by (auto simp add: image_iff valid_tuple_def tuple_since'_def
            Mapping_lookup_filter_Some split: option.splits)
        have "t'. valid_tuple tuple_since' (t', as)  valid_tuple tuple_since (t', as)"
          using Mapping_lookup_filter_not_None
          by (fastforce simp add: valid_tuple_def tuple_since'_def split: option.splits)
        then have "t'. (t', as)  ts_tuple_rel (set (linearize data_in)) 
          valid_tuple tuple_since' (t', as)  t'  t"
          using valid_before Some safe_max_Some_dest_le[OF finite_fst_ts_tuple_rel]
          by (fastforce simp add: image_iff)
        then have "Max (fst ` {tas  ts_tuple_rel (set (linearize data_in)).
          valid_tuple tuple_since' tas  as = snd tas}) = t"
          using Max_eqI[OF finite_fst_ts_tuple_rel[of "linearize data_in"],
            OF _ t_in_fst] by fastforce
        then show ?thesis
          unfolding lookup_tuple_in' using t_in_fst by (auto simp add: safe_max_def)
      next
        case False
        then have lookup_tuple': "Mapping.lookup tuple_in' as = None"
          "Mapping.lookup tuple_since' as = None"
          unfolding tuple_in'_def tuple_since'_def
          by (auto simp add: Mapping_lookup_filter_None)
        then have "tas. ¬(valid_tuple tuple_since' tas  as = snd tas)"
          by (auto simp add: valid_tuple_def split: option.splits)
        then show ?thesis
          unfolding lookup_tuple' by (auto simp add: safe_max_def)
      qed
    qed
  qed
  have table_join': "t ys. (t, ys)  set auxlist  table n R (join ys pos X)"
  proof -
    fix t ys
    assume "(t, ys)  set auxlist"
    then have table_ys: "table n R ys"
      using valid_before
      by (auto simp add: n_def L_def R_def pos_def)
    show "table n R (join ys pos X)"
      using join_table[OF table_ys table_left, of pos R] valid_before
      by (auto simp add: n_def L_def R_def pos_def)
  qed
  have table_in': "table n R (Mapping.keys tuple_in')"
    using tuple_in'_keys valid_before
    by (auto simp add: n_def L_def R_def pos_def table_def)
  have table_since': "table n R (Mapping.keys tuple_since')"
    using tuple_since'_keys valid_before
    by (auto simp add: n_def L_def R_def pos_def table_def)
  show ?thesis
    unfolding join_mmsaux_abs_eq[OF valid_before table_left']
    using valid_before ts_tuple_rel' lookup_tuple_in' tuple_in'_def tuple_since'_def table_join'
      Mapping_filter_keys[of tuple_since "λas. case as of Some t  t  nt"]
      table_in' table_since' by (auto simp add: n_def L_def R_def pos_def table_def Let_def)
qed

lemma valid_join_mmsaux: "valid_mmsaux args cur aux auxlist 
  table (args_n args) (args_L args) X  valid_mmsaux args cur
  (join_mmsaux args X aux) (map (λ(t, rel). (t, join rel (args_pos args) X)) auxlist)"
  using valid_join_mmsaux_unfolded by (cases aux) fast

fun gc_mmsaux :: "'a mmsaux  'a mmsaux" where
  "gc_mmsaux (nt, gc, maskL, maskR, data_prev, data_in, tuple_in, tuple_since) =
    (let all_tuples = (snd ` (set (linearize data_prev)  set (linearize data_in)));
    tuple_since' = Mapping.filter (λas _. as  all_tuples) tuple_since in
    (nt, nt, maskL, maskR, data_prev, data_in, tuple_in, tuple_since'))"

lemma valid_gc_mmsaux_unfolded:
  assumes valid_before: "valid_mmsaux args cur (nt, gc, maskL, maskR, data_prev, data_in,
    tuple_in, tuple_since) ys"
  shows "valid_mmsaux args cur (gc_mmsaux (nt, gc, maskL, maskR, data_prev, data_in,
    tuple_in, tuple_since)) ys"
proof -
  define n where "n = args_n args"
  define L where "L = args_L args"
  define R where "R = args_R args"
  define pos where "pos = args_pos args"
  define all_tuples where "all_tuples  (snd ` (set (linearize data_prev) 
    set (linearize data_in)))"
  define tuple_since' where "tuple_since'  Mapping.filter (λas _. as  all_tuples) tuple_since"
  have tuple_since_None_None: "as. Mapping.lookup tuple_since as = None 
    Mapping.lookup tuple_since' as = None"
    unfolding tuple_since'_def using Mapping_lookup_filter_not_None by fastforce
  have tuple_since'_keys: "as. as  Mapping.keys tuple_since'  as  Mapping.keys tuple_since"
    using tuple_since_None_None
    by (fastforce intro: Mapping_keys_intro dest: Mapping_keys_dest)
  then have table_since': "table n R (Mapping.keys tuple_since')"
    using valid_before by (auto simp add: table_def n_def R_def)
  have data_cong: "tas. tas  ts_tuple_rel (set (linearize data_prev) 
    set (linearize data_in))  valid_tuple tuple_since' tas = valid_tuple tuple_since tas"
  proof -
    fix tas
    assume assm: "tas  ts_tuple_rel (set (linearize data_prev) 
    set (linearize data_in))"
    define t where "t  fst tas"
    define as where "as  snd tas"
    have "as  all_tuples"
      using assm by (force simp add: as_def all_tuples_def ts_tuple_rel_def)
    then have "Mapping.lookup tuple_since' as = Mapping.lookup tuple_since as"
      by (auto simp add: tuple_since'_def Mapping.lookup_filter split: option.splits)
    then show "valid_tuple tuple_since' tas = valid_tuple tuple_since tas"
      by (auto simp add: valid_tuple_def as_def split: option.splits) metis
  qed
  then have data_in_cong: "tas. tas  ts_tuple_rel (set (linearize data_in)) 
    valid_tuple tuple_since' tas = valid_tuple tuple_since tas"
    by (auto simp add: ts_tuple_rel_Un)
  have "ts_tuple_rel (set ys) =
    {tas  ts_tuple_rel (set (linearize data_prev)  set (linearize data_in)).
    valid_tuple tuple_since' tas}"
    using data_cong valid_before by auto
  moreover have "(as. Mapping.lookup tuple_in as = safe_max (fst `
    {tas  ts_tuple_rel (set (linearize data_in)). valid_tuple tuple_since' tas  as = snd tas}))"
    using valid_before by auto (meson data_in_cong)
  moreover have "(as  Mapping.keys tuple_since'. case Mapping.lookup tuple_since' as of
    Some t  t  nt)"
    using Mapping.keys_filter valid_before
    by (auto simp add: tuple_since'_def Mapping.lookup_filter split: option.splits
        intro!: Mapping_keys_intro dest: Mapping_keys_dest)
  ultimately show ?thesis
    using all_tuples_def tuple_since'_def valid_before table_since'
    by (auto simp add: n_def R_def)
qed

lemma valid_gc_mmsaux: "valid_mmsaux args cur aux ys  valid_mmsaux args cur (gc_mmsaux aux) ys"
  using valid_gc_mmsaux_unfolded by (cases aux) fast

fun gc_join_mmsaux :: "args  'a table  'a mmsaux  'a mmsaux" where
  "gc_join_mmsaux args X (t, gc, maskL, maskR, data_prev, data_in, tuple_in, tuple_since) =
    (if enat (t - gc) > right (args_ivl args) then join_mmsaux args X (gc_mmsaux (t, gc, maskL, maskR,
      data_prev, data_in, tuple_in, tuple_since))
    else join_mmsaux args X (t, gc, maskL, maskR, data_prev, data_in, tuple_in, tuple_since))"

lemma gc_join_mmsaux_alt: "gc_join_mmsaux args rel1 aux = join_mmsaux args rel1 (gc_mmsaux aux) 
  gc_join_mmsaux args rel1 aux = join_mmsaux args rel1 aux"
  by (cases aux) (auto simp only: gc_join_mmsaux.simps split: if_splits)

lemma valid_gc_join_mmsaux:
  assumes "valid_mmsaux args cur aux auxlist" "table (args_n args) (args_L args) rel1"
  shows "valid_mmsaux args cur (gc_join_mmsaux args rel1 aux)
    (map (λ(t, rel). (t, join rel (args_pos args) rel1)) auxlist)"
  using gc_join_mmsaux_alt[of args rel1 aux]
  using valid_join_mmsaux[OF valid_gc_mmsaux[OF assms(1)] assms(2)]
    valid_join_mmsaux[OF assms]
  by auto

fun add_new_table_mmsaux :: "args  'a table  'a mmsaux  'a mmsaux" where
  "add_new_table_mmsaux args X (t, gc, maskL, maskR, data_prev, data_in, tuple_in, tuple_since) =
    (let tuple_since = upd_set tuple_since (λ_. t) (X - Mapping.keys tuple_since) in
    (if 0  left (args_ivl args) then (t, gc, maskL, maskR, data_prev, append_queue (t, X) data_in,
      upd_set tuple_in (λ_. t) X, tuple_since)
    else (t, gc, maskL, maskR, append_queue (t, X) data_prev, data_in, tuple_in, tuple_since)))"

lemma valid_add_new_table_mmsaux_unfolded:
  assumes valid_before: "valid_mmsaux args cur
    (nt, gc, maskL, maskR, data_prev, data_in, tuple_in, tuple_since) auxlist"
  and table_X: "table (args_n args) (args_R args) X"
  shows "valid_mmsaux args cur (add_new_table_mmsaux args X
    (nt, gc, maskL, maskR, data_prev, data_in, tuple_in, tuple_since))
    (case auxlist of
      [] => [(cur, X)]
    | ((t, y) # ts)  if t = cur then (t, y  X) # ts else (cur, X) # auxlist)"
proof -
  have cur_nt: "cur = nt"
    using valid_before by auto
  define I where "I = args_ivl args"
  define n where "n = args_n args"
  define L where "L = args_L args"
  define R where "R = args_R args"
  define pos where "pos = args_pos args"
  define tuple_in' where "tuple_in'  upd_set tuple_in (λ_. nt) X"
  define tuple_since' where "tuple_since'  upd_set tuple_since (λ_. nt)
    (X - Mapping.keys tuple_since)"
  define data_prev' where "data_prev'  append_queue (nt, X) data_prev"
  define data_in' where "data_in'  append_queue (nt, X) data_in"
  define auxlist' where "auxlist'  (case auxlist of
    [] => [(nt, X)]
    | ((t, y) # ts)  if t = nt then (t, y  X) # ts else (nt, X) # auxlist)"
  have table_in': "table n R (Mapping.keys tuple_in')"
    using table_X valid_before
    by (auto simp add: table_def tuple_in'_def Mapping_upd_set_keys n_def R_def)
  have table_since': "table n R (Mapping.keys tuple_since')"
    using table_X valid_before
    by (auto simp add: table_def tuple_since'_def Mapping_upd_set_keys n_def R_def)
  have tuple_since'_keys: "Mapping.keys tuple_since  Mapping.keys tuple_since'"
    using Mapping_upd_set_keys by (fastforce simp add: tuple_since'_def)
  have lin_data_prev': "linearize data_prev' = linearize data_prev @ [(nt, X)]"
    unfolding data_prev'_def append_queue_rep ..
  have wf_data_prev': "as. as  (snd ` (set (linearize data_prev')))  wf_tuple n R as"
    unfolding lin_data_prev' using table_X valid_before
    by (auto simp add: table_def n_def R_def)
  have lin_data_in': "linearize data_in' = linearize data_in @ [(nt, X)]"
    unfolding data_in'_def append_queue_rep ..
  have table_auxlist': "(t, X)  set auxlist'. table n R X"
    using table_X table_Un valid_before
    by (auto simp add: auxlist'_def n_def R_def split: list.splits if_splits)
  have lookup_tuple_since': "as  Mapping.keys tuple_since'.
    case Mapping.lookup tuple_since' as of Some t  t  nt"
    unfolding tuple_since'_def using valid_before Mapping_lookup_upd_set[of tuple_since]
    by (auto dest: Mapping_keys_dest intro!: Mapping_keys_intro split: if_splits option.splits)
  have ts_tuple_rel_auxlist': "ts_tuple_rel (set auxlist') =
    ts_tuple_rel (set auxlist)  ts_tuple_rel {(nt, X)}"
    unfolding auxlist'_def
    using ts_tuple_rel_ext ts_tuple_rel_ext' ts_tuple_rel_ext_Cons ts_tuple_rel_ext_Cons'
    by (fastforce simp: ts_tuple_rel_def split: list.splits if_splits)
  have valid_tuple_nt_X: "tas. tas  ts_tuple_rel {(nt, X)}  valid_tuple tuple_since' tas"
    using valid_before by (auto simp add: ts_tuple_rel_def valid_tuple_def tuple_since'_def
        Mapping_lookup_upd_set dest: Mapping_keys_dest split: option.splits)
  have valid_tuple_mono: "tas. valid_tuple tuple_since tas  valid_tuple tuple_since' tas"
    by (auto simp add: valid_tuple_def tuple_since'_def Mapping_lookup_upd_set
        intro: Mapping_keys_intro split: option.splits)
  have ts_tuple_rel_auxlist': "ts_tuple_rel (set auxlist') =
    {tas  ts_tuple_rel (set (linearize data_prev)  set (linearize data_in)  {(nt, X)}).
    valid_tuple tuple_since' tas}"
  proof (rule set_eqI, rule iffI)
    fix tas
    assume assm: "tas  ts_tuple_rel (set auxlist')"
    show "tas  {tas  ts_tuple_rel (set (linearize data_prev) 
      set (linearize data_in)  {(nt, X)}). valid_tuple tuple_since' tas}"
      using assm[unfolded ts_tuple_rel_auxlist' ts_tuple_rel_Un]
    proof (rule UnE)
      assume assm: "tas  ts_tuple_rel (set auxlist)"
      then have "tas  {tas  ts_tuple_rel (set (linearize data_prev) 
        set (linearize data_in)). valid_tuple tuple_since tas}"
        using valid_before by auto
      then show "tas  {tas  ts_tuple_rel (set (linearize data_prev) 
        set (linearize data_in)  {(nt, X)}). valid_tuple tuple_since' tas}"
        using assm by (auto simp only: ts_tuple_rel_Un intro: valid_tuple_mono)
    next
      assume assm: "tas  ts_tuple_rel {(nt, X)}"
      show "tas  {tas  ts_tuple_rel (set (linearize data_prev) 
        set (linearize data_in)  {(nt, X)}). valid_tuple tuple_since' tas}"
        using assm valid_before by (auto simp add: ts_tuple_rel_Un tuple_since'_def
            valid_tuple_def Mapping_lookup_upd_set ts_tuple_rel_def dest: Mapping_keys_dest
            split: option.splits if_splits)
    qed
  next
    fix tas
    assume assm: "tas  {tas  ts_tuple_rel (set (linearize data_prev) 
      set (linearize data_in)  {(nt, X)}). valid_tuple tuple_since' tas}"
    then have "tas  (ts_tuple_rel (set (linearize data_prev) 
      set (linearize data_in)) - ts_tuple_rel {(nt, X)})  ts_tuple_rel {(nt, X)}"
      by (auto simp only: ts_tuple_rel_Un)
    then show "tas  ts_tuple_rel (set auxlist')"
    proof (rule UnE)
      assume assm': "tas  ts_tuple_rel (set (linearize data_prev) 
        set (linearize data_in)) - ts_tuple_rel {(nt, X)}"
      then have tas_in: "tas  ts_tuple_rel (set (linearize data_prev) 
        set (linearize data_in))"
        by (auto simp only: ts_tuple_rel_def)
      obtain t as where tas_def: "tas = (t, as)"
        by (cases tas) auto
      have "t  fst ` (set (linearize data_prev)  set (linearize data_in))"
        using assm' unfolding tas_def by (force simp add: ts_tuple_rel_def)
      then have t_le_nt: "t  nt"
        using valid_before by auto
      have valid_tas: "valid_tuple tuple_since' tas"
        using assm by auto
      have "valid_tuple tuple_since tas"
      proof (cases "as  Mapping.keys tuple_since")
        case True
        then show ?thesis
          using valid_tas tas_def by (auto simp add: valid_tuple_def tuple_since'_def
              Mapping_lookup_upd_set split: option.splits if_splits)
      next
        case False
        then have "t = nt" "as  X"
          using valid_tas t_le_nt unfolding tas_def
          by (auto simp add: valid_tuple_def tuple_since'_def Mapping_lookup_upd_set
              intro: Mapping_keys_intro split: option.splits if_splits)
        then have "False"
          using assm' unfolding tas_def ts_tuple_rel_def by (auto simp only: ts_tuple_rel_def)
        then show ?thesis
          by simp
      qed
      then show "tas  ts_tuple_rel (set auxlist')"
        using tas_in valid_before by (auto simp add: ts_tuple_rel_auxlist')
    qed (auto simp only: ts_tuple_rel_auxlist')
  qed
  show ?thesis
  proof (cases "0  left I")
    case True
    then have add_def: "add_new_table_mmsaux args X (nt, gc, maskL, maskR, data_prev, data_in,
      tuple_in, tuple_since) = (nt, gc, maskL, maskR, data_prev, data_in',
      tuple_in', tuple_since')"
      using data_in'_def tuple_in'_def tuple_since'_def unfolding I_def by auto
    have left_I: "left I = 0"
      using True by auto
    have "t  fst ` set (linearize data_in'). t  nt  nt - t  left I"
      using valid_before True by (auto simp add: lin_data_in')
    moreover have "as. Mapping.lookup tuple_in' as = safe_max (fst `
      {tas  ts_tuple_rel (set (linearize data_in')).
      valid_tuple tuple_since' tas  as = snd tas})"
    proof -
      fix as
      show "Mapping.lookup tuple_in' as = safe_max (fst `
        {tas  ts_tuple_rel (set (linearize data_in')).
        valid_tuple tuple_since' tas  as = snd tas})"
      proof (cases "as  X")
        case True
        have "valid_tuple tuple_since' (nt, as)"
          using True valid_before by (auto simp add: valid_tuple_def tuple_since'_def
              Mapping_lookup_upd_set dest: Mapping_keys_dest split: option.splits)
        moreover have "(nt, as)  ts_tuple_rel (insert (nt, X) (set (linearize data_in)))"
          using True by (auto simp add: ts_tuple_rel_def)
        ultimately have nt_in: "nt  fst ` {tas  ts_tuple_rel (insert (nt, X)
          (set (linearize data_in))). valid_tuple tuple_since' tas  as = snd tas}"
        proof -
          assume a1: "valid_tuple tuple_since' (nt, as)"
          assume "(nt, as)  ts_tuple_rel (insert (nt, X) (set (linearize data_in)))"
          then have "p. nt = fst p  p  ts_tuple_rel (insert (nt, X)
            (set (linearize data_in)))  valid_tuple tuple_since' p  as = snd p"
            using a1 by simp
          then show "nt  fst ` {p  ts_tuple_rel (insert (nt, X) (set (linearize data_in))).
            valid_tuple tuple_since' p  as = snd p}"
            by blast
        qed
        moreover have "t. t  fst ` {tas  ts_tuple_rel (insert (nt, X)
          (set (linearize data_in))). valid_tuple tuple_since' tas  as = snd tas}  t  nt"
          using valid_before by (auto split: option.splits)
            (metis (no_types, lifting) eq_imp_le fst_conv insertE ts_tuple_rel_dest)
        ultimately have "Max (fst ` {tas  ts_tuple_rel (set (linearize data_in)
           set [(nt, X)]). valid_tuple tuple_since' tas  as = snd tas}) = nt"
          using Max_eqI[OF finite_fst_ts_tuple_rel[of "linearize data_in'"],
              unfolded lin_data_in' set_append] by auto
        then show ?thesis
          using nt_in True
          by (auto simp add: tuple_in'_def Mapping_lookup_upd_set safe_max_def lin_data_in')
      next
        case False
        have "{tas  ts_tuple_rel (set (linearize data_in)).
          valid_tuple tuple_since tas  as = snd tas} =
          {tas  ts_tuple_rel (set (linearize data_in')).
          valid_tuple tuple_since' tas  as = snd tas}"
          using False by (fastforce simp add: lin_data_in' ts_tuple_rel_def valid_tuple_def
              tuple_since'_def Mapping_lookup_upd_set intro: Mapping_keys_intro
              split: option.splits if_splits)
        then show ?thesis
          using valid_before False by (auto simp add: tuple_in'_def Mapping_lookup_upd_set)
      qed
    qed
    ultimately show ?thesis
      using assms table_auxlist' sorted_append[of "map fst (linearize data_in)"]
        lookup_tuple_since' ts_tuple_rel_auxlist' table_in' table_since'
      unfolding add_def auxlist'_def[symmetric] cur_nt I_def
      by (auto simp only: valid_mmsaux.simps lin_data_in' n_def R_def) auto
  next
    case False
    then have add_def: "add_new_table_mmsaux args X (nt, gc, maskL, maskR, data_prev, data_in,
      tuple_in, tuple_since) = (nt, gc, maskL, maskR, data_prev', data_in,
      tuple_in, tuple_since')"
      using data_prev'_def tuple_since'_def unfolding I_def by auto
    have left_I: "left I > 0"
      using False by auto
    have "t  fst ` set (linearize data_prev'). t  nt  nt - t < left I"
      using valid_before False by (auto simp add: lin_data_prev' I_def)
    moreover have "as. {tas  ts_tuple_rel (set (linearize data_in)).
      valid_tuple tuple_since tas  as = snd tas} =
      {tas  ts_tuple_rel (set (linearize data_in)).
      valid_tuple tuple_since' tas  as = snd tas}"
    proof (rule set_eqI, rule iffI)
      fix as tas
      assume assm: "tas  {tas  ts_tuple_rel (set (linearize data_in)).
        valid_tuple tuple_since' tas  as = snd tas}"
      then obtain t Z where Z_def: "tas = (t, as)" "as  Z" "(t, Z)  set (linearize data_in)"
        "valid_tuple tuple_since' (t, as)"
        by (auto simp add: ts_tuple_rel_def)
      show "tas  {tas  ts_tuple_rel (set (linearize data_in)).
        valid_tuple tuple_since tas  as = snd tas}"
      using assm
      proof (cases "as  Mapping.keys tuple_since")
        case False
        then have "t  nt"
          using Z_def(4) by (auto simp add: valid_tuple_def tuple_since'_def
              Mapping_lookup_upd_set intro: Mapping_keys_intro split: option.splits if_splits)
        then show ?thesis
          using Z_def(3) valid_before left_I unfolding I_def by auto
      qed (auto simp add: valid_tuple_def tuple_since'_def Mapping_lookup_upd_set
           dest: Mapping_keys_dest split: option.splits)
    qed (auto simp add: Mapping_lookup_upd_set valid_tuple_def tuple_since'_def
         intro: Mapping_keys_intro split: option.splits)
    ultimately show ?thesis
      using assms table_auxlist' sorted_append[of "map fst (linearize data_prev)"]
        False lookup_tuple_since' ts_tuple_rel_auxlist' table_in' table_since' wf_data_prev'
        valid_before
      unfolding add_def auxlist'_def[symmetric] cur_nt I_def
      by (auto simp only: valid_mmsaux.simps lin_data_prev' n_def R_def) fastforce+
        (* takes long *)
  qed
qed

lemma valid_add_new_table_mmsaux:
  assumes valid_before: "valid_mmsaux args cur aux auxlist"
  and table_X: "table (args_n args) (args_R args) X"
  shows "valid_mmsaux args cur (add_new_table_mmsaux args X aux)
    (case auxlist of
      [] => [(cur, X)]
    | ((t, y) # ts)  if t = cur then (t, y  X) # ts else (cur, X) # auxlist)"
  using valid_add_new_table_mmsaux_unfolded assms
  by (cases aux) fast

lemma foldr_ts_tuple_rel:
  "as  foldr (∪) (concat (map (λ(t, rel). if P t then [rel] else []) auxlist)) {} 
  (t. (t, as)  ts_tuple_rel (set auxlist)  P t)"
proof (rule iffI)
  assume assm: "as  foldr (∪) (concat (map (λ(t, rel). if P t then [rel] else []) auxlist)) {}"
  then obtain t X where tX_def: "P t" "as  X" "(t, X)  set auxlist"
    by (auto elim!: in_foldr_UnE)
  then show "t. (t, as)  ts_tuple_rel (set auxlist)  P t"
    by (auto simp add: ts_tuple_rel_def)
next
  assume assm: "t. (t, as)  ts_tuple_rel (set auxlist)  P t"
  then obtain t X where tX_def: "P t" "as  X" "(t, X)  set auxlist"
    by (auto simp add: ts_tuple_rel_def)
  show "as  foldr (∪) (concat (map (λ(t, rel). if P t then [rel] else []) auxlist)) {}"
    using in_foldr_UnI[OF tX_def(2)] tX_def assm by (induction auxlist) force+
qed

lemma image_snd: "(a, b)  X  b  snd ` X"
  by force

fun result_mmsaux :: "args  'a mmsaux  'a table" where
  "result_mmsaux args (nt, gc, maskL, maskR, data_prev, data_in, tuple_in, tuple_since) =
    Mapping.keys tuple_in"

lemma valid_result_mmsaux_unfolded:
  assumes "valid_mmsaux args cur
    (t, gc, maskL, maskR, data_prev, data_in, tuple_in, tuple_since) auxlist"
  shows "result_mmsaux args (t, gc, maskL, maskR, data_prev, data_in, tuple_in, tuple_since) =
    foldr (∪) [rel. (t, rel)  auxlist, left (args_ivl args)  cur - t] {}"
  using valid_mmsaux_tuple_in_keys[OF assms] assms
  by (auto simp add: image_Un ts_tuple_rel_Un foldr_ts_tuple_rel image_snd)
     (fastforce intro: ts_tuple_rel_intro dest: ts_tuple_rel_dest)+

lemma valid_result_mmsaux: "valid_mmsaux args cur aux auxlist 
  result_mmsaux args aux = foldr (∪) [rel. (t, rel)  auxlist, left (args_ivl args)  cur - t] {}"
  using valid_result_mmsaux_unfolded by (cases aux) fast

interpretation default_msaux: msaux valid_mmsaux init_mmsaux add_new_ts_mmsaux gc_join_mmsaux
  add_new_table_mmsaux result_mmsaux
  using valid_init_mmsaux valid_add_new_ts_mmsaux valid_gc_join_mmsaux valid_add_new_table_mmsaux
    valid_result_mmsaux
  by unfold_locales assumption+

subsection ‹Optimized data structure for Until›

type_synonym tp = nat

type_synonym 'a mmuaux = "tp × ts queue × nat × bool list × bool list ×
  ('a tuple, tp) mapping × (tp, ('a tuple, ts + tp) mapping) mapping × 'a table list × nat"

definition tstp_lt :: "ts + tp  ts  tp  bool" where
  "tstp_lt tstp ts tp = case_sum (λts'. ts'  ts) (λtp'. tp' < tp) tstp"

definition tstp_le :: "ts + tp  ts  tp  bool" where
  "tstp_le tstp ts tp = case_sum (λts'. ts'  ts) (λtp'. tp'  tp) tstp"

definition ts_tp_lt :: "ts  tp  ts + tp  bool" where
  "ts_tp_lt ts tp tstp = case_sum (λts'. ts  ts') (λtp'. tp < tp') tstp"

definition ts_tp_lt' :: "ts  tp  ts + tp  bool" where
  "ts_tp_lt' ts tp tstp = case_sum (λts'. ts < ts') (λtp'. tp  tp') tstp"

definition ts_tp_le :: "ts  tp  ts + tp  bool" where
  "ts_tp_le ts tp tstp = case_sum (λts'. ts  ts') (λtp'. tp  tp') tstp"

fun max_tstp :: "ts + tp  ts + tp  ts + tp" where
  "max_tstp (Inl ts) (Inl ts') = Inl (max ts ts')"
| "max_tstp (Inr tp) (Inr tp') = Inr (max tp tp')"
| "max_tstp (Inl ts) _ = Inl ts"
| "max_tstp _ (Inl ts) = Inl ts"

lemma max_tstp_idem: "max_tstp (max_tstp x y) y = max_tstp x y"
  by (cases x; cases y) auto

lemma max_tstp_idem': "max_tstp x (max_tstp x y) = max_tstp x y"
  by (cases x; cases y) auto

lemma max_tstp_d_d: "max_tstp d d = d"
  by (cases d) auto

lemma max_cases: "(max a b = a  P)  (max a b = b  P)  P"
  by (metis max_def)

lemma max_tstpE: "isl tstp  isl tstp'  (max_tstp tstp tstp' = tstp  P) 
  (max_tstp tstp tstp' = tstp'  P)  P"
  by (cases tstp; cases tstp') (auto elim: max_cases)

lemma max_tstp_intro: "tstp_lt tstp ts tp  tstp_lt tstp' ts tp  isl tstp  isl tstp' 
  tstp_lt (max_tstp tstp tstp') ts tp"
  by (auto simp add: tstp_lt_def split: sum.splits)

lemma max_tstp_intro': "isl tstp  isl tstp' 
  ts_tp_le ts' tp' tstp  ts_tp_le ts' tp' (max_tstp tstp tstp')"
  by (cases tstp; cases tstp') (auto simp add: ts_tp_le_def tstp_le_def split: sum.splits)

lemma max_tstp_intro'': "isl tstp  isl tstp' 
  ts_tp_le ts' tp' tstp'  ts_tp_le ts' tp' (max_tstp tstp tstp')"
  by (cases tstp; cases tstp') (auto simp add: ts_tp_le_def tstp_le_def split: sum.splits)

lemma max_tstp_intro''': "isl tstp  isl tstp' 
  ts_tp_lt' ts' tp' tstp  ts_tp_lt' ts' tp' (max_tstp tstp tstp')"
  by (cases tstp; cases tstp') (auto simp add: ts_tp_lt'_def tstp_le_def split: sum.splits)

lemma max_tstp_intro'''': "isl tstp  isl tstp' 
  ts_tp_lt' ts' tp' tstp'  ts_tp_lt' ts' tp' (max_tstp tstp tstp')"
  by (cases tstp; cases tstp') (auto simp add: ts_tp_lt'_def tstp_le_def split: sum.splits)

lemma max_tstp_isl: "isl tstp  isl tstp'  isl (max_tstp tstp tstp')  isl tstp"
  by (cases tstp; cases tstp') auto

definition filter_a1_map :: "bool  tp  ('a tuple, tp) mapping  'a table" where
  "filter_a1_map pos tp a1_map =
    {xs  Mapping.keys a1_map. case Mapping.lookup a1_map xs of Some tp' 
    (pos  tp'  tp)  (¬pos  tp  tp')}"

definition filter_a2_map :: "ℐ  ts  tp  (tp, ('a tuple, ts + tp) mapping) mapping 
  'a table" where
  "filter_a2_map I ts tp a2_map = {xs. tp'  tp. (case Mapping.lookup a2_map tp' of Some m 
    (case Mapping.lookup m xs of Some tstp  ts_tp_lt' ts tp tstp | _  False)
    | _  False)}"

fun triple_eq_pair :: "('a × 'b × 'c)  ('a × 'd)  ('d  'b)  ('a  'd  'c)  bool" where
  "triple_eq_pair (t, a1, a2) (ts', tp') f g  t = ts'  a1 = f tp'  a2 = g ts' tp'"

fun valid_mmuaux' :: "args  ts  ts  'a mmuaux  'a muaux  bool" where
  "valid_mmuaux' args cur dt (tp, tss, len, maskL, maskR, a1_map, a2_map,
    done, done_length) auxlist 
    args_L args  args_R args 
    maskL = join_mask (args_n args) (args_L args) 
    maskR = join_mask (args_n args) (args_R args) 
    len  tp 
    length (linearize tss) = len  sorted (linearize tss) 
    (t  set (linearize tss). t  cur  enat cur  enat t + right (args_ivl args)) 
    table (args_n args) (args_L args) (Mapping.keys a1_map) 
    Mapping.keys a2_map = {tp - len..tp} 
    (xs  Mapping.keys a1_map. case Mapping.lookup a1_map xs of Some tp'  tp' < tp) 
    (tp'  Mapping.keys a2_map. case Mapping.lookup a2_map tp' of Some m 
      table (args_n args) (args_R args) (Mapping.keys m) 
      (xs  Mapping.keys m. case Mapping.lookup m xs of Some tstp 
      tstp_lt tstp (cur - (left (args_ivl args) - 1)) tp  (isl tstp  left (args_ivl args) > 0))) 
    length done = done_length  length done + len = length auxlist 
    rev done = map proj_thd (take (length done) auxlist) 
    (x  set (take (length done) auxlist). check_before (args_ivl args) dt x) 
    sorted (map fst auxlist) 
    list_all2 (λx y. triple_eq_pair x y (λtp'. filter_a1_map (args_pos args) tp' a1_map)
      (λts' tp'. filter_a2_map (args_ivl args) ts' tp' a2_map)) (drop (length done) auxlist)
      (zip (linearize tss) [tp - len..<tp])"

definition valid_mmuaux :: "args  ts  'a mmuaux  'a muaux 
  bool" where
  "valid_mmuaux args cur = valid_mmuaux' args cur cur"

fun eval_step_mmuaux :: "'a mmuaux  'a mmuaux" where
  "eval_step_mmuaux (tp, tss, len, maskL, maskR, a1_map, a2_map,
    done, done_length) = (case safe_hd tss of (Some ts, tss') 
      (case Mapping.lookup a2_map (tp - len) of Some m 
        let m = Mapping.filter (λ_ tstp. ts_tp_lt' ts (tp - len) tstp) m;
        T = Mapping.keys m;
        a2_map = Mapping.update (tp - len + 1)
          (case Mapping.lookup a2_map (tp - len + 1) of Some m' 
          Mapping.combine (λtstp tstp'. max_tstp tstp tstp') m m') a2_map;
        a2_map = Mapping.delete (tp - len) a2_map in
        (tp, tl_queue tss', len - 1, maskL, maskR, a1_map, a2_map,
        T # done, done_length + 1)))"

lemma Mapping_update_keys: "Mapping.keys (Mapping.update a b m) = Mapping.keys m  {a}"
  by transfer auto

lemma drop_is_Cons_take: "drop n xs = y # ys  take (Suc n) xs = take n xs @ [y]"
proof (induction xs arbitrary: n)
  case Nil
  then show ?case by simp
next
  case (Cons x xs)
  then show ?case by (cases n) simp_all
qed

lemma list_all2_weaken: "list_all2 f xs ys 
  (x y. (x, y)  set (zip xs ys)  f x y  f' x y)  list_all2 f' xs ys"
  by (induction xs ys rule: list_all2_induct) auto

lemma Mapping_lookup_delete: "Mapping.lookup (Mapping.delete k m) k' =
  (if k = k' then None else Mapping.lookup m k')"
  by transfer auto

lemma Mapping_lookup_update: "Mapping.lookup (Mapping.update k v m) k' =
  (if k = k' then Some v else Mapping.lookup m k')"
  by transfer auto

lemma hd_le_set: "sorted xs  xs  []  x  set xs  hd xs  x"
  by (metis eq_iff list.sel(1) set_ConsD sorted.elims(2))

lemma Mapping_lookup_combineE: "Mapping.lookup (Mapping.combine f m m') k = Some v 
  (Mapping.lookup m k = Some v  P) 
  (Mapping.lookup m' k = Some v  P) 
  (v' v''. Mapping.lookup m k = Some v'  Mapping.lookup m' k = Some v'' 
  f v' v'' = v  P)  P"
  unfolding Mapping.lookup_combine
  by (auto simp add: combine_options_def split: option.splits)

lemma Mapping_keys_filterI: "Mapping.lookup m k = Some v  f k v 
  k  Mapping.keys (Mapping.filter f m)"
  by transfer (auto split: option.splits if_splits)

lemma Mapping_keys_filterD: "k  Mapping.keys (Mapping.filter f m) 
  v. Mapping.lookup m k = Some v  f k v"
  by transfer (auto split: option.splits if_splits)

fun lin_ts_mmuaux :: "'a mmuaux  ts list" where
  "lin_ts_mmuaux (tp, tss, len, maskL, maskR, a1_map, a2_map, done, done_length) =
    linearize tss"

lemma valid_eval_step_mmuaux':
  assumes "valid_mmuaux' args cur dt aux auxlist"
    "lin_ts_mmuaux aux = ts # tss''" "enat ts + right (args_ivl args) < dt"
  shows "valid_mmuaux' args cur dt (eval_step_mmuaux aux) auxlist 
    lin_ts_mmuaux (eval_step_mmuaux aux) = tss''"
proof -
  define I where "I = args_ivl args"
  define n where "n = args_n args"
  define L where "L = args_L args"
  define R where "R = args_R args"
  define pos where "pos = args_pos args"
  obtain tp len tss maskL maskR a1_map a2_map "done" done_length where aux_def:
    "aux = (tp, tss, len, maskL, maskR, a1_map, a2_map, done, done_length)"
    by (cases aux) auto
  then obtain tss' where safe_hd_eq: "safe_hd tss = (Some ts, tss')"
    using assms(2) safe_hd_rep case_optionE
    by (cases "safe_hd tss") fastforce
  note valid_before = assms(1)[unfolded aux_def]
  have lin_tss_not_Nil: "linearize tss  []"
    using safe_hd_rep[OF safe_hd_eq] by auto
  have ts_hd: "ts = hd (linearize tss)"
    using safe_hd_rep[OF safe_hd_eq] by auto
  have lin_tss': "linearize tss' = linearize tss"
    using safe_hd_rep[OF safe_hd_eq] by auto
  have tss'_not_empty: "¬is_empty tss'"
    using is_empty_alt[of tss'] lin_tss_not_Nil unfolding lin_tss' by auto
  have len_pos: "len > 0"
    using lin_tss_not_Nil valid_before by auto
  have a2_map_keys: "Mapping.keys a2_map = {tp - len..tp}"
    using valid_before by auto
  have len_tp: "len  tp"
    using valid_before by auto
  have tp_minus_keys: "tp - len  Mapping.keys a2_map"
    using a2_map_keys by auto
  have tp_minus_keys': "tp - len + 1  Mapping.keys a2_map"
    using a2_map_keys len_pos len_tp by auto
  obtain m where m_def: "Mapping.lookup a2_map (tp - len) = Some m"
    using tp_minus_keys by (auto dest: Mapping_keys_dest)
  have "table n R (Mapping.keys m)"
    "(xs  Mapping.keys m. case Mapping.lookup m xs of Some tstp 
    tstp_lt tstp (cur - (left I - 1)) tp  (isl tstp  left I > 0))"
    using tp_minus_keys m_def valid_before
    unfolding valid_mmuaux'.simps n_def I_def R_def by fastforce+
  then have m_inst: "table n R (Mapping.keys m)"
    "xs tstp. Mapping.lookup m xs = Some tstp 
    tstp_lt tstp (cur - (left I - 1)) tp  (isl tstp  left I > 0)"
    using Mapping_keys_intro by fastforce+
  have m_inst_isl: "xs tstp. Mapping.lookup m xs = Some tstp  isl tstp  left I > 0"
    using m_inst(2) by fastforce
  obtain m' where m'_def: "Mapping.lookup a2_map (tp - len + 1) = Some m'"
    using tp_minus_keys' by (auto dest: Mapping_keys_dest)
  have "table n R (Mapping.keys m')"
    "(xs  Mapping.keys m'. case Mapping.lookup m' xs of Some tstp 
    tstp_lt tstp (cur - (left I - 1)) tp  (isl tstp  left I > 0))"
    using tp_minus_keys' m'_def valid_before
    unfolding valid_mmuaux'.simps I_def n_def R_def by fastforce+
  then have m'_inst: "table n R (Mapping.keys m')"
    "xs tstp. Mapping.lookup m' xs = Some tstp 
    tstp_lt tstp (cur - (left I - 1)) tp  (isl tstp  left I > 0)"
    using Mapping_keys_intro by fastforce+
  have m'_inst_isl: "xs tstp. Mapping.lookup m' xs = Some tstp  isl tstp  left I > 0"
    using m'_inst(2) by fastforce
  define m_upd where "m_upd = Mapping.filter (λ_ tstp. ts_tp_lt' ts (tp - len) tstp) m"
  define T where "T = Mapping.keys m_upd"
  define mc where "mc = Mapping.combine (λtstp tstp'. max_tstp tstp tstp') m_upd m'"
  define a2_map' where "a2_map' = Mapping.update (tp - len + 1) mc a2_map"
  define a2_map'' where "a2_map'' = Mapping.delete (tp - len) a2_map'"
  have m_upd_lookup: "xs tstp. Mapping.lookup m_upd xs = Some tstp 
    tstp_lt tstp (cur - (left I - 1)) tp  (isl tstp  left I > 0)"
    unfolding m_upd_def Mapping.lookup_filter
    using m_inst(2) by (auto split: option.splits if_splits)
  have mc_lookup: "xs tstp. Mapping.lookup mc xs = Some tstp 
    tstp_lt tstp (cur - (left I - 1)) tp  (isl tstp  left I > 0)"
    unfolding mc_def Mapping.lookup_combine
    using m_upd_lookup m'_inst(2)
    by (auto simp add: combine_options_def max_tstp_isl intro: max_tstp_intro split: option.splits)
  have mc_keys: "Mapping.keys mc  Mapping.keys m  Mapping.keys m'"
    unfolding mc_def Mapping.keys_combine m_upd_def
    using Mapping.keys_filter by fastforce
  have tp_len_assoc: "tp - len + 1 = tp - (len - 1)"
    using len_pos len_tp by auto
  have a2_map''_keys: "Mapping.keys a2_map'' = {tp - (len - 1)..tp}"
    unfolding a2_map''_def a2_map'_def Mapping.keys_delete Mapping_update_keys a2_map_keys
    using tp_len_assoc by auto
  have lin_tss_Cons: "linearize tss = ts # linearize (tl_queue tss')"
    using lin_tss_not_Nil
    by (auto simp add: tl_queue_rep[OF tss'_not_empty] lin_tss' ts_hd)
  have tp_len_tp_unfold: "[tp - len..<tp] = (tp - len) # [tp - (len - 1)..<tp]"
    unfolding tp_len_assoc[symmetric]
    using len_pos len_tp Suc_diff_le upt_conv_Cons by auto
  have id: "x. x  {tp - (len - 1) + 1..tp} 
    Mapping.lookup a2_map'' x = Mapping.lookup a2_map x"
    unfolding a2_map''_def a2_map'_def Mapping_lookup_delete Mapping_lookup_update tp_len_assoc
    using len_tp by auto
  have list_all2: "list_all2 (λx y. triple_eq_pair x y (λtp'. filter_a1_map pos tp' a1_map)
    (λts' tp'. filter_a2_map I ts' tp' a2_map))
    (drop (length done) auxlist) (zip (linearize tss) [tp - len..<tp])"
    using valid_before unfolding I_def pos_def by auto
  obtain hd_aux tl_aux where aux_split: "drop (length done) auxlist = hd_aux # tl_aux"
    "case hd_aux of (t, a1, a2)  (t, a1, a2) =
    (ts, filter_a1_map pos (tp - len) a1_map, filter_a2_map I ts (tp - len) a2_map)"
    and list_all2': "list_all2 (λx y. triple_eq_pair x y (λtp'. filter_a1_map pos tp' a1_map)
      (λts' tp'. filter_a2_map I ts' tp' a2_map)) tl_aux
      (zip (linearize (tl_queue tss')) [tp - (len - 1)..<tp])"
    using list_all2[unfolded lin_tss_Cons tp_len_tp_unfold zip_Cons_Cons list_all2_Cons2] by auto
  have lookup''_tp_minus: "Mapping.lookup a2_map'' (tp - (len - 1)) = Some mc"
    unfolding a2_map''_def a2_map'_def Mapping_lookup_delete Mapping_lookup_update
      tp_len_assoc[symmetric]
    using len_tp by auto
  have filter_a2_map_cong: "ts' tp'. ts'  set (linearize tss) 
    tp'  {tp - (len - 1)..<tp}  filter_a2_map I ts' tp' a2_map =
    filter_a2_map I ts' tp' a2_map''"
  proof (rule set_eqI, rule iffI)
    fix ts' tp' xs
    assume assms: "ts'  set (linearize tss)"
      "tp'  {tp - (len - 1)..<tp}" "xs  filter_a2_map I ts' tp' a2_map"
    obtain tp_bef m_bef tstp where defs: "tp_bef  tp'" "Mapping.lookup a2_map tp_bef = Some m_bef"
      "Mapping.lookup m_bef xs = Some tstp" "ts_tp_lt' ts' tp' tstp"
      using assms(3)[unfolded filter_a2_map_def]
      by (fastforce split: option.splits)
    have ts_le_ts': "ts  ts'"
      using hd_le_set[OF _ lin_tss_not_Nil assms(1)] valid_before
      unfolding ts_hd by auto
    have tp_bef_in: "tp_bef  {tp - len..tp}"
      using defs(2) valid_before by (auto intro!: Mapping_keys_intro)
    have tp_minus_le: "tp - (len - 1)  tp'"
      using assms(2) by auto
    show "xs  filter_a2_map I ts' tp' a2_map''"
    proof (cases "tp_bef  tp - (len - 1)")
      case True
      show ?thesis
      proof (cases "tp_bef = tp - len")
        case True
        have m_bef_m: "m_bef = m"
          using defs(2) m_def
          unfolding True by auto
        have "Mapping.lookup m_upd xs = Some tstp"
          using defs(3,4) assms(2) ts_le_ts' unfolding m_bef_m m_upd_def
          by (auto simp add: Mapping.lookup_filter ts_tp_lt'_def intro: Mapping_keys_intro
              split: sum.splits)
        then have "case Mapping.lookup mc xs of None  False | Some tstp 
          ts_tp_lt' ts' tp' tstp"
          unfolding mc_def Mapping.lookup_combine
          using m'_inst(2) m_upd_lookup
          by (auto simp add: combine_options_def defs(4) intro!: max_tstp_intro'''
              dest: Mapping_keys_dest split: option.splits)
        then show ?thesis
          using lookup''_tp_minus tp_minus_le defs
          unfolding m_bef_m filter_a2_map_def by (auto split: option.splits)
      next
        case False
        then have "tp_bef = tp - (len - 1)"
          using True tp_bef_in by auto
        then have m_bef_m: "m_bef = m'"
          using defs(2) m'_def
          unfolding tp_len_assoc by auto
        have "case Mapping.lookup mc xs of None  False | Some tstp 
          ts_tp_lt' ts' tp' tstp"
          unfolding mc_def Mapping.lookup_combine
          using m'_inst(2) m_upd_lookup defs(3)[unfolded m_bef_m]
          by (auto simp add: combine_options_def defs(4) intro!: max_tstp_intro''''
              dest: Mapping_keys_dest split: option.splits)
        then show ?thesis
          using lookup''_tp_minus tp_minus_le defs
          unfolding m_bef_m filter_a2_map_def by (auto split: option.splits)
      qed
    next
      case False
      then have "Mapping.lookup a2_map'' tp_bef = Mapping.lookup a2_map tp_bef"
        using id tp_bef_in len_tp by auto
      then show ?thesis
        unfolding filter_a2_map_def
        using defs by auto
    qed
  next
    fix ts' tp' xs
    assume assms: "ts'  set (linearize tss)" "tp'  {tp - (len - 1)..<tp}"
      "xs  filter_a2_map I ts' tp' a2_map''"
    obtain tp_bef m_bef tstp where defs: "tp_bef  tp'"
      "Mapping.lookup a2_map'' tp_bef = Some m_bef"
      "Mapping.lookup m_bef xs = Some tstp" "ts_tp_lt' ts' tp' tstp"
      using assms(3)[unfolded filter_a2_map_def]
      by (fastforce split: option.splits)
    have ts_le_ts': "ts  ts'"
      using hd_le_set[OF _ lin_tss_not_Nil assms(1)] valid_before
      unfolding ts_hd by auto
    have tp_bef_in: "tp_bef  {tp - (len - 1)..tp}"
      using defs(2) a2_map''_keys by (auto intro!: Mapping_keys_intro)
    have tp_minus_le: "tp - len  tp'" "tp - (len - 1)  tp'"
      using assms(2) by auto
    show "xs  filter_a2_map I ts' tp' a2_map"
    proof (cases "tp_bef = tp - (len - 1)")
      case True
      have m_beg_mc: "m_bef = mc"
        using defs(2)
        unfolding True a2_map''_def a2_map'_def tp_len_assoc Mapping_lookup_delete
          Mapping.lookup_update
        by (auto split: if_splits)
      show ?thesis
        using defs(3)[unfolded m_beg_mc mc_def]
      proof (rule Mapping_lookup_combineE)
        assume lassm: "Mapping.lookup m_upd xs = Some tstp"
        then show "xs  filter_a2_map I ts' tp' a2_map"
          unfolding m_upd_def Mapping.lookup_filter
          using m_def tp_minus_le(1) defs
          by (auto simp add: filter_a2_map_def split: option.splits if_splits)
      next
        assume lassm: "Mapping.lookup m' xs = Some tstp"
        then show "xs  filter_a2_map I ts' tp' a2_map"
          using m'_def defs(4) tp_minus_le defs
          unfolding filter_a2_map_def tp_len_assoc
          by auto
      next
        fix v' v''
        assume lassms: "Mapping.lookup m_upd xs = Some v'" "Mapping.lookup m' xs = Some v''"
          "max_tstp v' v'' = tstp"
        show "xs  filter_a2_map I ts' tp' a2_map"
        proof (rule max_tstpE)
          show "isl v' = isl v''"
            using lassms(1,2) m_upd_lookup m'_inst(2)
            by auto
        next
          assume "max_tstp v' v'' = v'"
          then show "xs  filter_a2_map I ts' tp' a2_map"
            using lassms(1,3) m_def defs tp_minus_le(1)
            unfolding tp_len_assoc m_upd_def Mapping.lookup_filter
            by (auto simp add: filter_a2_map_def split: option.splits if_splits)
        next
          assume "max_tstp v' v'' = v''"
          then show "xs  filter_a2_map I ts' tp' a2_map"
            using lassms(2,3) m'_def defs tp_minus_le(2)
            unfolding tp_len_assoc
            by (auto simp add: filter_a2_map_def)
        qed
      qed
    next
      case False
      then have "Mapping.lookup a2_map'' tp_bef = Mapping.lookup a2_map tp_bef"
        using id tp_bef_in by auto
      then show ?thesis
        unfolding filter_a2_map_def
        using defs by auto (metis option.simps(5))
    qed
  qed
  have set_tl_tss': "set (linearize (tl_queue tss'))  set (linearize tss)"
    unfolding tl_queue_rep[OF tss'_not_empty] lin_tss_Cons by auto
  have list_all2'': "list_all2 (λx y. triple_eq_pair x y (λtp'. filter_a1_map pos tp' a1_map)
      (λts' tp'. filter_a2_map I ts' tp' a2_map'')) tl_aux
      (zip (linearize (tl_queue tss')) [tp - (len - 1)..<tp])"
    using filter_a2_map_cong set_tl_tss'
    by (intro list_all2_weaken[OF list_all2']) (auto elim!: in_set_zipE split: prod.splits)
  have lookup'': "tp'  Mapping.keys a2_map''. case Mapping.lookup a2_map'' tp' of Some m 
    table n R (Mapping.keys m)  (xs  Mapping.keys m. case Mapping.lookup m xs of Some tstp 
    tstp_lt tstp (cur - (left I - 1)) tp  isl tstp = (0 < left I))"
  proof (rule ballI)
    fix tp'
    assume assm: "tp'  Mapping.keys a2_map''"
    then obtain f where f_def: "Mapping.lookup a2_map'' tp' = Some f"
      by (auto dest: Mapping_keys_dest)
    have tp'_in: "tp'  {tp - (len - 1)..tp}"
      using assm unfolding a2_map''_keys .
    then have tp'_in_keys: "tp'  Mapping.keys a2_map"
      using valid_before by auto
    have "table n R (Mapping.keys f) 
      (xs  Mapping.keys f. case Mapping.lookup f xs of Some tstp 
      tstp_lt tstp (cur - (left I - 1)) tp  isl tstp = (0 < left I))"
    proof (cases "tp' = tp - (len - 1)")
      case True
      then have f_mc: "f = mc"
        using f_def
        unfolding a2_map''_def a2_map'_def Mapping_lookup_delete Mapping_lookup_update tp_len_assoc
        by (auto split: if_splits)
      have "table n R (Mapping.keys f)"
        unfolding f_mc
        using mc_keys m_def m'_def m_inst m'_inst
        by (auto simp add: table_def)
      moreover have "xs  Mapping.keys f. case Mapping.lookup f xs of Some tstp 
        tstp_lt tstp (cur - (left I - 1)) tp  isl tstp = (0 < left I)"
        using assm Mapping.keys_filter m_inst(2) m_inst_isl m'_inst(2) m'_inst_isl max_tstp_isl
        unfolding f_mc mc_def Mapping.lookup_combine
        by (auto simp add: combine_options_def m_upd_def Mapping.lookup_filter
            intro!: max_tstp_intro Mapping_keys_intro dest!: Mapping_keys_dest
            split: option.splits)
      ultimately show ?thesis
        by auto
    next
      case False
      have "Mapping.lookup a2_map tp' = Some f"
        using tp'_in id[of tp'] f_def False by auto
      then show ?thesis
        using tp'_in_keys valid_before
        unfolding valid_mmuaux'.simps I_def n_def R_def by fastforce
    qed
    then show "case Mapping.lookup a2_map'' tp' of Some m 
      table n R (Mapping.keys m)  (xs  Mapping.keys m. case Mapping.lookup m xs of Some tstp 
      tstp_lt tstp (cur - (left I - 1)) tp  isl tstp = (0 < left I))"
      using f_def by auto
  qed
  have tl_aux_def: "tl_aux = drop (length done + 1) auxlist"
    using aux_split(1) by (metis Suc_eq_plus1 add_Suc drop0 drop_Suc_Cons drop_drop)
  have T_eq: "T = filter_a2_map I ts (tp - len) a2_map"
  proof (rule set_eqI, rule iffI)
    fix xs
    assume "xs  filter_a2_map I ts (tp - len) a2_map"
    then obtain tp_bef m_bef tstp where defs: "tp_bef  tp - len"
      "Mapping.lookup a2_map tp_bef = Some m_bef"
      "Mapping.lookup m_bef xs = Some tstp" "ts_tp_lt' ts (tp - len) tstp"
      by (fastforce simp add: filter_a2_map_def split: option.splits)
    then have tp_bef_minus: "tp_bef = tp - len"
      using valid_before Mapping_keys_intro by force
    have m_bef_m: "m_bef = m"
      using defs(2) m_def
      unfolding tp_bef_minus by auto
    show "xs  T"
      using defs
      unfolding T_def m_upd_def m_bef_m
      by (auto intro: Mapping_keys_filterI Mapping_keys_intro)
  next
    fix xs
    assume "xs  T"
    then show "xs  filter_a2_map I ts (tp - len) a2_map"
      using m_def Mapping.keys_filter
      unfolding T_def m_upd_def filter_a2_map_def
      by (auto simp add: filter_a2_map_def dest!: Mapping_keys_filterD split: if_splits)
  qed
  have min_auxlist_done: "min (length auxlist) (length done) = length done"
    using valid_before by auto
  then have "x  set (take (length done) auxlist). check_before I dt x"
    "rev done = map proj_thd (take (length done) auxlist)"
    using valid_before unfolding I_def by auto
  then have list_all': "(x  set (take (length (T # done)) auxlist). check_before I dt x)"
    "rev (T # done) = map proj_thd (take (length (T # done)) auxlist)"
    using drop_is_Cons_take[OF aux_split(1)] aux_split(2) assms(3)
    by (auto simp add: T_eq I_def)
  have eval_step_mmuaux_eq: "eval_step_mmuaux (tp, tss, len, maskL, maskR, a1_map, a2_map,
    done, done_length) = (tp, tl_queue tss', len - 1,  maskL, maskR, a1_map, a2_map'',
    T # done, done_length + 1)"
    using safe_hd_eq m_def m'_def m_upd_def T_def mc_def a2_map'_def a2_map''_def
    by (auto simp add: Let_def)
  have "lin_ts_mmuaux (eval_step_mmuaux aux) = tss''"
    using lin_tss_Cons assms(2) unfolding aux_def eval_step_mmuaux_eq by auto
  then show ?thesis
    using valid_before a2_map''_keys sorted_tl list_all' lookup'' list_all2''
    unfolding eval_step_mmuaux_eq valid_mmuaux'.simps tl_aux_def aux_def I_def n_def R_def pos_def
    using lin_tss_not_Nil safe_hd_eq len_pos
    by (auto simp add: list.set_sel(2) lin_tss' tl_queue_rep[OF tss'_not_empty] min_auxlist_done)
qed

lemma done_empty_valid_mmuaux'_intro:
  assumes "valid_mmuaux' args cur dt
    (tp, tss, len, maskL, maskR, a1_map, a2_map, done, done_length) auxlist"
  shows "valid_mmuaux' args cur dt'
    (tp, tss, len, maskL, maskR, a1_map, a2_map, [], 0)
    (drop (length done) auxlist)"
  using assms sorted_drop by (auto simp add: drop_map[symmetric])

lemma valid_mmuaux'_mono:
  assumes "valid_mmuaux' args cur dt aux auxlist" "dt  dt'"
  shows "valid_mmuaux' args cur dt' aux auxlist"
  using assms less_le_trans by (cases aux) fastforce

lemma valid_foldl_eval_step_mmuaux':
  assumes valid_before: "valid_mmuaux' args cur dt aux auxlist"
    "lin_ts_mmuaux aux = tss @ tss'"
    "ts. ts  set (take (length tss) (lin_ts_mmuaux aux))  enat ts + right (args_ivl args) < dt"
  shows "valid_mmuaux' args cur dt (foldl (λaux _. eval_step_mmuaux aux) aux tss) auxlist 
    lin_ts_mmuaux (foldl (λaux _. eval_step_mmuaux aux) aux tss) = tss'"
  using assms
proof (induction tss arbitrary: aux)
  case (Cons ts tss)
  have app_ass: "lin_ts_mmuaux aux = ts # (tss @ tss')"
    using Cons(3) by auto
  have "enat ts + right (args_ivl args) < dt"
    using Cons by auto
  then have valid_step: "valid_mmuaux' args cur dt (eval_step_mmuaux aux) auxlist"
    "lin_ts_mmuaux (eval_step_mmuaux aux) = tss @ tss'"
    using valid_eval_step_mmuaux'[OF Cons(2) app_ass] by auto
  show ?case
    using Cons(1)[OF valid_step] valid_step Cons(4) app_ass by auto
qed auto

lemma sorted_dropWhile_filter: "sorted xs  dropWhile (λt. enat t + right I < enat nt) xs =
  filter (λt. ¬enat t + right I < enat nt) xs"
proof (induction xs)
  case (Cons x xs)
  then show ?case
  proof (cases "enat x + right I < enat nt")
    case False
    then have neg: "enat x + right I  enat nt"
      by auto
    have "z. z  set xs  ¬enat z + right I < enat nt"
    proof -
      fix z
      assume "z  set xs"
      then have "enat z + right I  enat x + right I"
        using Cons by auto
      with neg have "enat z + right I  enat nt"
        using dual_order.trans by blast
      then show "¬enat z + right I < enat nt"
        by auto
    qed
    with False show ?thesis
      using filter_empty_conv by auto
  qed auto
qed auto

fun shift_mmuaux :: "args  ts  'a mmuaux  'a mmuaux" where
  "shift_mmuaux args nt (tp, tss, len, maskL, maskR, a1_map, a2_map, done, done_length) =
    (let tss_list = linearize (takeWhile_queue (λt. enat t + right (args_ivl args) < enat nt) tss) in
    foldl (λaux _. eval_step_mmuaux aux) (tp, tss, len, maskL, maskR,
      a1_map, a2_map, done, done_length) tss_list)"

lemma valid_shift_mmuaux':
  assumes "valid_mmuaux' args cur cur aux auxlist" "nt  cur"
  shows "valid_mmuaux' args cur nt (shift_mmuaux args nt aux) auxlist 
    (ts  set (lin_ts_mmuaux (shift_mmuaux args nt aux)). ¬enat ts + right (args_ivl args) < nt)"
proof -
  define I where "I = args_ivl args"
  define pos where "pos = args_pos args"
  have valid_folded: "valid_mmuaux' args cur nt aux auxlist"
    using assms(1,2) valid_mmuaux'_mono unfolding valid_mmuaux_def by blast
  obtain tp len tss maskL maskR a1_map a2_map "done" done_length where aux_def:
    "aux = (tp, tss, len, maskL, maskR, a1_map, a2_map, done, done_length)"
    by (cases aux) auto
  note valid_before = valid_folded[unfolded aux_def]
  define tss_list where "tss_list =
    linearize (takeWhile_queue (λt. enat t + right I < enat nt) tss)"
  have tss_list_takeWhile: "tss_list = takeWhile (λt. enat t + right I < enat nt) (linearize tss)"
    using tss_list_def unfolding takeWhile_queue_rep .
  then obtain tss_list' where tss_list'_def: "linearize tss = tss_list @ tss_list'"
    "tss_list' = dropWhile (λt. enat t + right I < enat nt) (linearize tss)"
    by auto
  obtain tp' len' tss' maskL' maskR' a1_map' a2_map' "done'" done_length' where
    foldl_aux_def: "(tp', tss', len', maskL', maskR', a1_map', a2_map',
      done', done_length') = foldl (λaux _. eval_step_mmuaux aux) aux tss_list"
    by (cases "foldl (λaux _. eval_step_mmuaux aux) aux tss_list") auto
  have lin_tss_aux: "lin_ts_mmuaux aux = linearize tss"
    unfolding aux_def by auto
  have "take (length tss_list) (lin_ts_mmuaux aux) = tss_list"
    unfolding lin_tss_aux using tss_list'_def(1) by auto
  then have valid_foldl: "valid_mmuaux' args cur nt
    (foldl (λaux _. eval_step_mmuaux aux) aux tss_list) auxlist"
    "lin_ts_mmuaux (foldl (λaux _. eval_step_mmuaux aux) aux tss_list) = tss_list'"
    using valid_foldl_eval_step_mmuaux'[OF valid_before[folded aux_def], unfolded lin_tss_aux,
      OF tss_list'_def(1)] tss_list_takeWhile set_takeWhileD
    unfolding lin_tss_aux I_def by fastforce+
  have shift_mmuaux_eq: "shift_mmuaux args nt aux = foldl (λaux _. eval_step_mmuaux aux) aux tss_list"
    using tss_list_def unfolding aux_def I_def by auto
  have "ts. ts  set tss_list'  ¬enat ts + right (args_ivl args) < nt"
    using sorted_dropWhile_filter tss_list'_def(2) valid_before unfolding I_def by auto
  then show ?thesis
    using valid_foldl(1)[unfolded shift_mmuaux_eq[symmetric]]
    unfolding valid_foldl(2)[unfolded shift_mmuaux_eq[symmetric]] by auto
qed

lift_definition upd_set' :: "('a, 'b) mapping  'b  ('b  'b)  'a set  ('a, 'b) mapping" is
  "λm d f X a. (if a  X then (case Mapping.lookup m a of Some b  Some (f b) | None  Some d)
    else Mapping.lookup m a)" .

lemma upd_set'_lookup: "Mapping.lookup (upd_set' m d f X) a = (if a  X then
  (case Mapping.lookup m a of Some b  Some (f b) | None  Some d) else Mapping.lookup m a)"
  by (simp add: Mapping.lookup.rep_eq upd_set'.rep_eq)

lemma upd_set'_keys: "Mapping.keys (upd_set' m d f X) = Mapping.keys m  X"
  by (auto simp add: upd_set'_lookup intro!: Mapping_keys_intro
      dest!: Mapping_keys_dest split: option.splits)

lift_definition upd_nested :: "('a, ('b, 'c) mapping) mapping 
  'c  ('c  'c)  ('a × 'b) set  ('a, ('b, 'c) mapping) mapping" is
  "λm d f X a. case Mapping.lookup m a of Some m'  Some (upd_set' m' d f {b. (a, b)  X})
  | None  if a  fst ` X then Some (upd_set' Mapping.empty d f {b. (a, b)  X}) else None" .

lemma upd_nested_lookup: "Mapping.lookup (upd_nested m d f X) a =
  (case Mapping.lookup m a of Some m'  Some (upd_set' m' d f {b. (a, b)  X})
  | None  if a  fst ` X then Some (upd_set' Mapping.empty d f {b. (a, b)  X}) else None)"
  by (simp add: Mapping.lookup.abs_eq upd_nested.abs_eq)

lemma upd_nested_keys: "Mapping.keys (upd_nested m d f X) = Mapping.keys m  fst ` X"
  by (auto simp add: upd_nested_lookup Domain.DomainI fst_eq_Domain intro!: Mapping_keys_intro
      dest!: Mapping_keys_dest split: option.splits)

fun add_new_mmuaux :: "args  'a table  'a table  ts  'a mmuaux  'a mmuaux" where
  "add_new_mmuaux args rel1 rel2 nt aux =
    (let (tp, tss, len, maskL, maskR, a1_map, a2_map, done, done_length) =
    shift_mmuaux args nt aux;
    I = args_ivl args; pos = args_pos args;
    new_tstp = (if left I = 0 then Inr tp else Inl (nt - (left I - 1)));
    tmp = ((λas. case Mapping.lookup a1_map (proj_tuple maskL as) of None 
      (if ¬pos then {(tp - len, as)} else {})
      | Some tp'  if pos then {(max (tp - len) tp', as)}
      else {(max (tp - len) (tp' + 1), as)}) ` rel2)  (if left I = 0 then {tp} × rel2 else {});
    a2_map = Mapping.update (tp + 1) Mapping.empty
      (upd_nested a2_map new_tstp (max_tstp new_tstp) tmp);
    a1_map = (if pos then Mapping.filter (λas _. as  rel1)
      (upd_set a1_map (λ_. tp) (rel1 - Mapping.keys a1_map)) else upd_set a1_map (λ_. tp) rel1);
    tss = append_queue nt tss in
    (tp + 1, tss, len + 1, maskL, maskR, a1_map, a2_map, done, done_length))"

lemma fst_case: "(λx. fst (case x of (t, a1, a2)  (t, y t a1 a2, z t a1 a2))) = fst"
  by auto

lemma list_all2_in_setE: "list_all2 P xs ys  x  set xs  (y. y  set ys  P x y  Q)  Q"
  by (fastforce simp: list_all2_iff set_zip in_set_conv_nth)

lemma list_all2_zip: "list_all2 (λx y. triple_eq_pair x y f g) xs (zip ys zs) 
  (y. y  set ys  Q y)  x  set xs  Q (fst x)"
  by (auto simp: in_set_zip elim!: list_all2_in_setE triple_eq_pair.elims)

lemma list_appendE: "xs = ys @ zs  x  set xs 
  (x  set ys  P)  (x  set zs  P)  P"
  by auto

lemma take_takeWhile: "n  length ys 
  (y. y  set (take n ys)  P y) 
  (y. y  set (drop n ys)  ¬P y) 
  take n ys = takeWhile P ys"
proof (induction ys arbitrary: n)
  case Nil
  then show ?case by simp
next
  case (Cons y ys)
  then show ?case by (cases n) simp_all
qed

lemma valid_add_new_mmuaux:
  assumes valid_before: "valid_mmuaux args cur aux auxlist"
    and tabs: "table (args_n args) (args_L args) rel1" "table (args_n args) (args_R args) rel2"
    and nt_mono: "nt  cur"
  shows "valid_mmuaux args nt (add_new_mmuaux args rel1 rel2 nt aux)
    (update_until args rel1 rel2 nt auxlist)"
proof -
  define I where "I = args_ivl args"
  define n where "n = args_n args"
  define L where "L = args_L args"
  define R where "R = args_R args"
  define pos where "pos = args_pos args"
  have valid_folded: "valid_mmuaux' args cur nt aux auxlist"
    using assms(1,4) valid_mmuaux'_mono unfolding valid_mmuaux_def by blast
  obtain tp len tss maskL maskR a1_map a2_map "done" done_length where shift_aux_def:
    "shift_mmuaux args nt aux = (tp, tss, len, maskL, maskR, a1_map, a2_map, done, done_length)"
    by (cases "shift_mmuaux args nt aux") auto
  have valid_shift_aux: "valid_mmuaux' args cur nt (tp, tss, len, maskL, maskR,
    a1_map, a2_map, done, done_length) auxlist"
    "ts. ts  set (linearize tss)  ¬enat ts + right (args_ivl args) < enat nt"
    using valid_shift_mmuaux'[OF assms(1)[unfolded valid_mmuaux_def] assms(4)]
    unfolding shift_aux_def by auto
  define new_tstp where "new_tstp = (if left I = 0 then Inr tp else Inl (nt - (left I - 1)))"
  have new_tstp_lt_isl: "tstp_lt new_tstp (nt - (left I - 1)) (tp + 1)"
    "isl new_tstp  left I > 0"
    by (auto simp add: new_tstp_def tstp_lt_def)
  define tmp where "tmp = ((λas. case Mapping.lookup a1_map (proj_tuple maskL as) of None 
    (if ¬pos then {(tp - len, as)} else {})
    | Some tp'  if pos then {(max (tp - len) tp', as)}
    else {(max (tp - len) (tp' + 1), as)}) ` rel2)  (if left I = 0 then {tp} × rel2 else {})"
  have a1_map_lookup: "as tp'. Mapping.lookup a1_map as = Some tp'  tp' < tp"
    using valid_shift_aux(1) Mapping_keys_intro by force
  then have fst_tmp: "tp'. tp'  fst ` tmp  tp - len  tp'  tp' < tp + 1"
    unfolding tmp_def by (auto simp add: less_SucI split: option.splits if_splits)
  have snd_tmp: "tp'. table n R (snd ` tmp)"
    using tabs(2) unfolding tmp_def n_def R_def
    by (auto simp add: table_def split: if_splits option.splits)
  define a2_map' where "a2_map' = Mapping.update (tp + 1) Mapping.empty
    (upd_nested a2_map new_tstp (max_tstp new_tstp) tmp)"
  define a1_map' where "a1_map' = (if pos then Mapping.filter (λas _. as  rel1)
    (upd_set a1_map (λ_. tp) (rel1 - Mapping.keys a1_map)) else upd_set a1_map (λ_. tp) rel1)"
  define tss' where "tss' = append_queue nt tss"
  have add_new_mmuaux_eq: "add_new_mmuaux args rel1 rel2 nt aux = (tp + 1, tss', len + 1,
    maskL, maskR, a1_map', a2_map', done, done_length)"
    using shift_aux_def new_tstp_def tmp_def a2_map'_def a1_map'_def tss'_def
    unfolding I_def pos_def
    by (auto simp only: add_new_mmuaux.simps Let_def)
  have update_until_eq: "update_until args rel1 rel2 nt auxlist =
    (map (λx. case x of (t, a1, a2)  (t, if pos then join a1 True rel1 else a1  rel1,
      if mem (nt - t) I then a2  join rel2 pos a1 else a2)) auxlist) @
    [(nt, rel1, if left I = 0 then rel2 else empty_table)]"
    unfolding update_until_def I_def pos_def by simp
  have len_done_auxlist: "length done  length auxlist"
    using valid_shift_aux by auto
  have auxlist_split: "auxlist = take (length done) auxlist @ drop (length done) auxlist"
    using len_done_auxlist by auto
  have lin_tss': "linearize tss' = linearize tss @ [nt]"
    unfolding tss'_def append_queue_rep by (rule refl)
  have len_lin_tss': "length (linearize tss') = len + 1"
    unfolding lin_tss' using valid_shift_aux by auto
  have tmp: "sorted (linearize tss)" "t. t  set (linearize tss)  t  cur"
    using valid_shift_aux by auto
  have sorted_lin_tss': "sorted (linearize tss')"
    unfolding lin_tss' using tmp(1) le_trans[OF _ assms(4), OF tmp(2)]
    by (simp add: sorted_append)
  have in_lin_tss: "t. t  set (linearize tss) 
    t  cur  enat cur  enat t + right I"
    using valid_shift_aux(1) unfolding I_def by auto
  then have set_lin_tss': "t  set (linearize tss'). t  nt  enat nt  enat t + right I"
    unfolding lin_tss' I_def using le_trans[OF _ assms(4)] valid_shift_aux(2)
    by (auto simp add: not_less)
  have a1_map'_keys: "Mapping.keys a1_map'  Mapping.keys a1_map  rel1"
    unfolding a1_map'_def using Mapping.keys_filter Mapping_upd_set_keys
    by (auto simp add: Mapping_upd_set_keys split: if_splits dest: Mapping_keys_filterD)
  then have tab_a1_map'_keys: "table n L (Mapping.keys a1_map')"
    using valid_shift_aux(1) tabs(1) by (auto simp add: table_def n_def L_def)
  have a2_map_keys: "Mapping.keys a2_map = {tp - len..tp}"
    using valid_shift_aux by auto
  have a2_map'_keys: "Mapping.keys a2_map' = {tp - len..tp + 1}"
    unfolding a2_map'_def Mapping.keys_update upd_nested_keys a2_map_keys using fst_tmp
    by fastforce
  then have a2_map'_keys': "Mapping.keys a2_map' = {tp + 1 - (len + 1)..tp + 1}"
    by auto
  have len_upd_until: "length done + (len + 1) = length (update_until args rel1 rel2 nt auxlist)"
    using valid_shift_aux unfolding update_until_eq by auto
  have set_take_auxlist: "x. x  set (take (length done) auxlist)  check_before I nt x"
    using valid_shift_aux unfolding I_def by auto
  have list_all2_triple: "list_all2 (λx y. triple_eq_pair x y (λtp'. filter_a1_map pos tp' a1_map)
    (λts' tp'. filter_a2_map I ts' tp' a2_map)) (drop (length done) auxlist)
    (zip (linearize tss) [tp - len..<tp])"
    using valid_shift_aux unfolding I_def pos_def by auto
  have set_drop_auxlist: "x. x  set (drop (length done) auxlist)  ¬check_before I nt x"
    using valid_shift_aux(2)[OF list_all2_zip[OF list_all2_triple,
      of "λy. y  set (linearize tss)"]]
    unfolding I_def by auto
  have length_done_auxlist: "length done  length auxlist"
    using valid_shift_aux by auto
  have take_auxlist_takeWhile: "take (length done) auxlist = takeWhile (check_before I nt) auxlist"
    using take_takeWhile[OF length_done_auxlist set_take_auxlist set_drop_auxlist] .
  have "length done = length (takeWhile (check_before I nt) auxlist)"
    by (metis (no_types) add_diff_cancel_right' auxlist_split diff_diff_cancel
        length_append length_done_auxlist length_drop take_auxlist_takeWhile)
  then have set_take_auxlist': "x. x  set (take (length done)
    (update_until args rel1 rel2 nt auxlist))  check_before I nt x"
    by (metis I_def length_map map_proj_thd_update_until set_takeWhileD takeWhile_eq_take)
  have rev_done: "rev done = map proj_thd (take (length done) auxlist)"
    using valid_shift_aux by auto
  moreover have " = map proj_thd (takeWhile (check_before I nt)
    (update_until args rel1 rel2 nt auxlist))"
    by (simp add: take_auxlist_takeWhile map_proj_thd_update_until I_def)
  finally have rev_done': "rev done = map proj_thd (take (length done)
    (update_until args rel1 rel2 nt auxlist))"
    by (metis length_map length_rev takeWhile_eq_take)
  have map_fst_auxlist_take: "t. t  set (map fst (take (length done) auxlist))  t  nt"
    using set_take_auxlist
    by auto (meson add_increasing2 enat_ord_simps(1) le_cases not_less zero_le)
  have map_fst_auxlist_drop: "t. t  set (map fst (drop (length done) auxlist))  t  nt"
    using in_lin_tss[OF list_all2_zip[OF list_all2_triple, of "λy. y  set (linearize tss)"]]
      assms(4) dual_order.trans by auto blast
  have set_drop_auxlist_cong: "x t a1 a2. x  set (drop (length done) auxlist) 
    x = (t, a1, a2)  mem (nt - t) I  left I  nt - t"
  proof -
    fix x t a1 a2
    assume "x  set (drop (length done) auxlist)" "x = (t, a1, a2)"
    then have "enat t + right I  enat nt"
      using set_drop_auxlist not_less
      by auto blast
    then have "right I  enat (nt - t)"
      by (cases "right I") auto
    then show "mem (nt - t) I  left I  nt - t"
      by auto
  qed
  have sorted_fst_auxlist: "sorted (map fst auxlist)"
    using valid_shift_aux by auto
  have set_map_fst_auxlist: "t. t  set (map fst auxlist)  t  nt"
    using arg_cong[OF auxlist_split, of "map fst", unfolded map_append] map_fst_auxlist_take
      map_fst_auxlist_drop by auto
  have lookup_a1_map_keys: "xs tp'. Mapping.lookup a1_map xs = Some tp'  tp' < tp"
    using valid_shift_aux Mapping_keys_intro by force
  have lookup_a1_map_keys': "xs  Mapping.keys a1_map'.
    case Mapping.lookup a1_map' xs of Some tp'  tp' < tp + 1"
    using lookup_a1_map_keys unfolding a1_map'_def
    by (auto simp add: Mapping.lookup_filter Mapping_lookup_upd_set Mapping_upd_set_keys
        split: option.splits dest: Mapping_keys_dest) fastforce+
  have sorted_upd_until: "sorted (map fst (update_until args rel1 rel2 nt auxlist))"
    using sorted_fst_auxlist set_map_fst_auxlist
    unfolding update_until_eq
    by (auto simp add: sorted_append comp_def fst_case)
  have lookup_a2_map: "tp' m. Mapping.lookup a2_map tp' = Some m 
    table n R (Mapping.keys m)  (xs  Mapping.keys m. case Mapping.lookup m xs of Some tstp 
      tstp_lt tstp (cur - (left I - 1)) tp  (isl tstp  left I > 0))"
    using valid_shift_aux(1) Mapping_keys_intro unfolding I_def n_def R_def by force
  then have lookup_a2_map': "tp' m xs tstp. Mapping.lookup a2_map tp' = Some m 
    Mapping.lookup m xs = Some tstp  tstp_lt tstp (nt - (left I - 1)) tp 
    isl tstp = (0 < left I)"
    using Mapping_keys_intro assms(4) by (force simp add: tstp_lt_def split: sum.splits)
  have lookup_a2_map'_keys: "tp'  Mapping.keys a2_map'.
    case Mapping.lookup a2_map' tp' of Some m  table n R (Mapping.keys m) 
    (xs  Mapping.keys m. case Mapping.lookup m xs of Some tstp 
    tstp_lt tstp (nt - (left I - 1)) (tp + 1)  isl tstp = (0 < left I))"
  proof (rule ballI)
    fix tp'
    assume tp'_assm: "tp'  Mapping.keys a2_map'"
    then obtain m' where m'_def: "Mapping.lookup a2_map' tp' = Some m'"
      by (auto dest: Mapping_keys_dest)
    have "table n R (Mapping.keys m') 
      (xs  Mapping.keys m'. case Mapping.lookup m' xs of Some tstp 
      tstp_lt tstp (nt - (left I - 1)) (tp + 1)  isl tstp = (0 < left I))"
    proof (cases "tp' = tp + 1")
      case True
      show ?thesis
        using m'_def unfolding a2_map'_def True Mapping.lookup_update
        by (auto simp add: table_def)
    next
      case False
      then have tp'_in: "tp'  Mapping.keys a2_map"
        using tp'_assm unfolding a2_map_keys a2_map'_keys by auto
      then obtain m where m_def: "Mapping.lookup a2_map tp' = Some m"
        by (auto dest: Mapping_keys_dest)
      have m'_alt: "m' = upd_set' m new_tstp (max_tstp new_tstp) {b. (tp', b)  tmp}"
        using m_def m'_def unfolding a2_map'_def Mapping.lookup_update_neq[OF False[symmetric]]
          upd_nested_lookup
        by auto
      have "table n R (Mapping.keys m')"
        using lookup_a2_map[OF m_def] snd_tmp unfolding m'_alt upd_set'_keys
        by (auto simp add: table_def)
      moreover have "xs  Mapping.keys m'. case Mapping.lookup m' xs of Some tstp 
        tstp_lt tstp (nt - (left I - 1)) (tp + 1)  isl tstp = (0 < left I)"
      proof (rule ballI)
        fix xs
        assume xs_assm: "xs  Mapping.keys m'"
        then obtain tstp where tstp_def: "Mapping.lookup m' xs = Some tstp"
          by (auto dest: Mapping_keys_dest)
        have "tstp_lt tstp (nt - (left I - 1)) (tp + 1)  isl tstp = (0 < left I)"
        proof (cases "Mapping.lookup m xs")
          case None
          then show ?thesis
            using tstp_def[unfolded m'_alt upd_set'_lookup] new_tstp_lt_isl
            by (auto split: if_splits)
        next
          case (Some tstp')
          show ?thesis
          proof (cases "xs  {b. (tp', b)  tmp}")
            case True
            then have tstp_eq: "tstp = max_tstp new_tstp tstp'"
              using tstp_def[unfolded m'_alt upd_set'_lookup] Some
              by auto
            show ?thesis
              using lookup_a2_map'[OF m_def Some] new_tstp_lt_isl
              by (auto simp add: tstp_lt_def tstp_eq split: sum.splits)
          next
            case False
            then show ?thesis
              using tstp_def[unfolded m'_alt upd_set'_lookup] lookup_a2_map'[OF m_def Some] Some
              by (auto simp add: tstp_lt_def split: sum.splits)
          qed
        qed
        then show "case Mapping.lookup m' xs of Some tstp 
          tstp_lt tstp (nt - (left I - 1)) (tp + 1)  isl tstp = (0 < left I)"
          using tstp_def by auto
      qed
      ultimately show ?thesis
        by auto
    qed
    then show "case Mapping.lookup a2_map' tp' of Some m  table n R (Mapping.keys m) 
      (xs  Mapping.keys m. case Mapping.lookup m xs of Some tstp 
      tstp_lt tstp (nt - (left I - 1)) (tp + 1)  isl tstp = (0 < left I))"
      using m'_def by auto
  qed
  have tp_upt_Suc: "[tp + 1 - (len + 1)..<tp + 1] = [tp - len..<tp] @ [tp]"
    using upt_Suc by auto
  have map_eq: "map (λx. case x of (t, a1, a2)  (t, if pos then join a1 True rel1 else a1  rel1,
      if mem (nt - t) I then a2  join rel2 pos a1 else a2)) (drop (length done) auxlist) =
    map (λx. case x of (t, a1, a2)  (t, if pos then join a1 True rel1 else a1  rel1,
      if left I  nt - t then a2  join rel2 pos a1 else a2)) (drop (length done) auxlist)"
    using set_drop_auxlist_cong by auto
  have "drop (length done) (update_until args rel1 rel2 nt auxlist) =
    map (λx. case x of (t, a1, a2)  (t, if pos then join a1 True rel1 else a1  rel1,
      if mem (nt - t) I then a2  join rel2 pos a1 else a2)) (drop (length done) auxlist) @
    [(nt, rel1, if left I = 0 then rel2 else empty_table)]"
    unfolding update_until_eq using len_done_auxlist drop_map by auto
  note drop_update_until = this[unfolded map_eq]
  have list_all2_old: "list_all2 (λx y. triple_eq_pair x y (λtp'. filter_a1_map pos tp' a1_map')
    (λts' tp'. filter_a2_map I ts' tp' a2_map'))
    (map (λ(t, a1, a2). (t, if pos then join a1 True rel1 else a1  rel1,
      if left I  nt - t then a2  join rel2 pos a1 else a2)) (drop (length done) auxlist))
    (zip (linearize tss) [tp - len..<tp])"
    unfolding list_all2_map1
    using list_all2_triple
  proof (rule list.rel_mono_strong)
    fix tri pair
    assume tri_pair_in: "tri  set (drop (length done) auxlist)"
      "pair  set (zip (linearize tss) [tp - len..<tp])"
    obtain t a1 a2 where tri_def: "tri = (t, a1, a2)"
      by (cases tri) auto
    obtain ts' tp' where pair_def: "pair = (ts', tp')"
      by (cases pair) auto
    assume "triple_eq_pair tri pair (λtp'. filter_a1_map pos tp' a1_map)
      (λts' tp'. filter_a2_map I ts' tp' a2_map)"
    then have eqs: "t = ts'" "a1 = filter_a1_map pos tp' a1_map"
      "a2 = filter_a2_map I ts' tp' a2_map"
      unfolding tri_def pair_def by auto
    have tp'_ge: "tp'  tp - len"
      using tri_pair_in(2) unfolding pair_def
      by (auto elim: in_set_zipE)
    have tp'_lt_tp: "tp' < tp"
      using tri_pair_in(2) unfolding pair_def
      by (auto elim: in_set_zipE)
    have ts'_in_lin_tss: "ts'  set (linearize tss)"
      using tri_pair_in(2) unfolding pair_def
      by (auto elim: in_set_zipE)
    then have ts'_nt: "ts'  nt"
      using valid_shift_aux(1) assms(4) by auto
    then have t_nt: "t  nt"
      unfolding eqs(1) .
    have "table n L (Mapping.keys a1_map)"
      using valid_shift_aux unfolding n_def L_def by auto
    then have a1_tab: "table n L a1"
      unfolding eqs(2) filter_a1_map_def by (auto simp add: table_def)
    note tabR = tabs(2)[unfolded n_def[symmetric] R_def[symmetric]]
    have join_rel2_assms: "L  R" "maskL = join_mask n L"
      using valid_shift_aux unfolding n_def L_def R_def by auto
    have join_rel2_eq: "join rel2 pos a1 = {xs  rel2. proj_tuple_in_join pos maskL xs a1}"
      using join_sub[OF join_rel2_assms(1) a1_tab tabR] join_rel2_assms(2) by auto
    have filter_sub_a2: "xs m' tp'' tstp. tp''  tp' 
      Mapping.lookup a2_map' tp'' = Some m'  Mapping.lookup m' xs = Some tstp 
      ts_tp_lt' ts' tp' tstp  (tstp = new_tstp  False) 
      xs  filter_a2_map I ts' tp' a2_map'  xs  a2"
    proof -
      fix xs m' tp'' tstp
      assume m'_def: "tp''  tp'" "Mapping.lookup a2_map' tp'' = Some m'"
        "Mapping.lookup m' xs = Some tstp" "ts_tp_lt' ts' tp' tstp"
      have tp''_neq: "tp + 1  tp''"
        using le_less_trans[OF m'_def(1) tp'_lt_tp] by auto
      assume new_tstp_False: "tstp = new_tstp  False"
      show "xs  a2"
      proof (cases "Mapping.lookup a2_map tp''")
        case None
        then have m'_alt: "m' = upd_set' Mapping.empty new_tstp (max_tstp new_tstp)
          {b. (tp'', b)  tmp}"
          using m'_def(2)[unfolded a2_map'_def Mapping.lookup_update_neq[OF tp''_neq]
            upd_nested_lookup] by (auto split: option.splits if_splits)
        then show ?thesis
          using new_tstp_False m'_def(3)[unfolded m'_alt upd_set'_lookup Mapping.lookup_empty]
          by (auto split: if_splits)
      next
        case (Some m)
        then have m'_alt: "m' = upd_set' m new_tstp (max_tstp new_tstp) {b. (tp'', b)  tmp}"
          using m'_def(2)[unfolded a2_map'_def Mapping.lookup_update_neq[OF tp''_neq]
            upd_nested_lookup] by (auto split: option.splits if_splits)
        note lookup_m = Some
        show ?thesis
        proof (cases "Mapping.lookup m xs")
          case None
          then show ?thesis
            using new_tstp_False m'_def(3)[unfolded m'_alt upd_set'_lookup]
            by (auto split: if_splits)
        next
          case (Some tstp')
          have tstp_ok: "tstp = tstp'  xs  a2"
            using eqs(3) lookup_m Some m'_def unfolding filter_a2_map_def by auto
          show ?thesis
          proof (cases "xs  {b. (tp'', b)  tmp}")
            case True
            then have tstp_eq: "tstp = max_tstp new_tstp tstp'"
              using m'_def(3)[unfolded m'_alt upd_set'_lookup Some] by auto
            show ?thesis
              using lookup_a2_map'[OF lookup_m Some] new_tstp_lt_isl(2)
                tstp_eq new_tstp_False tstp_ok
              by (auto intro: max_tstpE[of new_tstp tstp'])
          next
            case False
            then have "tstp = tstp'"
              using m'_def(3)[unfolded m'_alt upd_set'_lookup Some] by auto
            then show ?thesis
              using tstp_ok by auto
          qed
        qed
      qed
    qed
    have a2_sub_filter: "a2  filter_a2_map I ts' tp' a2_map'"
    proof (rule subsetI)
      fix xs
      assume xs_in: "xs  a2"
      then obtain tp'' m tstp where m_def: "tp''  tp'" "Mapping.lookup a2_map tp'' = Some m"
        "Mapping.lookup m xs = Some tstp" "ts_tp_lt' ts' tp' tstp"
        using eqs(3)[unfolded filter_a2_map_def] by (auto split: option.splits)
      have tp''_in: "tp''  {tp - len..tp}"
        using m_def(2) a2_map_keys by (auto intro!: Mapping_keys_intro)
      then obtain m' where m'_def: "Mapping.lookup a2_map' tp'' = Some m'"
        using a2_map'_keys
        by (metis Mapping_keys_dest One_nat_def add_Suc_right add_diff_cancel_right'
            atLeastatMost_subset_iff diff_zero le_eq_less_or_eq le_less_Suc_eq subsetD)
      have tp''_neq: "tp + 1  tp''"
        using m_def(1) tp'_lt_tp by auto
      have m'_alt: "m' = upd_set' m new_tstp (max_tstp new_tstp) {b. (tp'', b)  tmp}"
        using m'_def[unfolded a2_map'_def Mapping.lookup_update_neq[OF tp''_neq] m_def(2)
          upd_nested_lookup] by (auto split: option.splits if_splits)
      show "xs  filter_a2_map I ts' tp' a2_map'"
      proof (cases "xs  {b. (tp'', b)  tmp}")
        case True
        then have "Mapping.lookup m' xs = Some (max_tstp new_tstp tstp)"
          unfolding m'_alt upd_set'_lookup m_def(3) by auto
        moreover have "ts_tp_lt' ts' tp' (max_tstp new_tstp tstp)"
          using new_tstp_lt_isl(2) lookup_a2_map'[OF m_def(2,3)]
          by (auto intro: max_tstp_intro''''[OF _ m_def(4)])
        ultimately show ?thesis
          unfolding filter_a2_map_def using m_def(1) m'_def m_def(4) by auto
      next
        case False
        then have "Mapping.lookup m' xs = Some tstp"
          unfolding m'_alt upd_set'_lookup m_def(3) by auto
        then show ?thesis
          unfolding filter_a2_map_def using m_def(1) m'_def m_def by auto
      qed
    qed
    have "pos  filter_a1_map pos tp' a1_map' = join a1 True rel1"
    proof -
      assume pos: pos
      note tabL = tabs(1)[unfolded n_def[symmetric] L_def[symmetric]]
      have join_eq: "join a1 True rel1 = a1  rel1"
        using join_eq[OF tabL a1_tab] by auto
      show "filter_a1_map pos tp' a1_map' = join a1 True rel1"
        using eqs(2) pos tp'_lt_tp unfolding filter_a1_map_def a1_map'_def join_eq
        by (auto simp add: Mapping.lookup_filter Mapping_lookup_upd_set split: if_splits option.splits
            intro: Mapping_keys_intro dest: Mapping_keys_dest Mapping_keys_filterD)
    qed
    moreover have "¬pos  filter_a1_map pos tp' a1_map' = a1  rel1"
      using eqs(2) tp'_lt_tp unfolding filter_a1_map_def a1_map'_def
      by (auto simp add: Mapping.lookup_filter Mapping_lookup_upd_set intro: Mapping_keys_intro
          dest: Mapping_keys_filterD Mapping_keys_dest split: option.splits)
    moreover have "left I  nt - t  filter_a2_map I ts' tp' a2_map' = a2  join rel2 pos a1"
    proof (rule set_eqI, rule iffI)
      fix xs
      assume in_int: "left I  nt - t"
      assume xs_in: "xs  filter_a2_map I ts' tp' a2_map'"
      then obtain m' tp'' tstp where m'_def: "tp''  tp'" "Mapping.lookup a2_map' tp'' = Some m'"
        "Mapping.lookup m' xs = Some tstp" "ts_tp_lt' ts' tp' tstp"
        unfolding filter_a2_map_def by (fastforce split: option.splits)
      show "xs  a2  join rel2 pos a1"
      proof (cases "tstp = new_tstp")
        case True
        note tstp_new_tstp = True
        have tp''_neq: "tp + 1  tp''"
          using m'_def(1) tp'_lt_tp by auto
        have tp''_in: "tp''  {tp - len..tp}"
          using m'_def(1,2) tp'_lt_tp a2_map'_keys
          by (auto intro!: Mapping_keys_intro)
        obtain m where m_def: "Mapping.lookup a2_map tp'' = Some m"
          "m' = upd_set' m new_tstp (max_tstp new_tstp) {b. (tp'', b)  tmp}"
          using m'_def(2)[unfolded a2_map'_def Mapping.lookup_update_neq[OF tp''_neq]
            upd_nested_lookup] tp''_in a2_map_keys
          by (fastforce dest: Mapping_keys_dest split: option.splits if_splits)
        show ?thesis
        proof (cases "Mapping.lookup m xs = Some new_tstp")
          case True
          then show ?thesis
            using eqs(3) m'_def(1) m_def(1) m'_def tstp_new_tstp
            unfolding filter_a2_map_def by auto
        next
          case False
          then have xs_in_snd_tmp: "xs  {b. (tp'', b)  tmp}"
            using m'_def(3)[unfolded m_def(2) upd_set'_lookup True]
            by (auto split: if_splits)
          then have xs_in_rel2: "xs  rel2"
            unfolding tmp_def
            by (auto split: if_splits option.splits)
          show ?thesis
          proof (cases pos)
            case True
            obtain tp''' where tp'''_def: "Mapping.lookup a1_map (proj_tuple maskL xs) = Some tp'''"
              "if pos then tp'' = max (tp - len) tp''' else tp'' = max (tp - len) (tp''' + 1)"
              using xs_in_snd_tmp m'_def(1) tp'_lt_tp True
              unfolding tmp_def by (auto split: option.splits if_splits)
            have "proj_tuple maskL xs  a1"
              using eqs(2)[unfolded filter_a1_map_def] True m'_def(1) tp'''_def
              by (auto intro: Mapping_keys_intro)
            then show ?thesis
              using True xs_in_rel2 unfolding proj_tuple_in_join_def join_rel2_eq by auto
          next
            case False
            show ?thesis
            proof (cases "Mapping.lookup a1_map (proj_tuple maskL xs)")
              case None
              then show ?thesis
                using xs_in_rel2 False eqs(2)[unfolded filter_a1_map_def]
                unfolding proj_tuple_in_join_def join_rel2_eq
                by (auto dest: Mapping_keys_dest)
            next
              case (Some tp''')
              then have "tp'' = max (tp - len) (tp''' + 1)"
                using xs_in_snd_tmp m'_def(1) tp'_lt_tp False
                unfolding tmp_def by (auto split: option.splits if_splits)
              then have "tp''' < tp'"
                using m'_def(1) by auto
              then have "proj_tuple maskL xs  a1"
                using eqs(2)[unfolded filter_a1_map_def] True m'_def(1) Some False
                by (auto intro: Mapping_keys_intro)
              then show ?thesis
                using xs_in_rel2 False unfolding proj_tuple_in_join_def join_rel2_eq by auto
            qed
          qed
        qed
      next
        case False
        then show ?thesis
          using filter_sub_a2[OF m'_def _ xs_in] by auto
      qed
    next
      fix xs
      assume in_int: "left I  nt - t"
      assume xs_in: "xs  a2  join rel2 pos a1"
      then have "xs  a2  (join rel2 pos a1 - a2)"
        by auto
      then show "xs  filter_a2_map I ts' tp' a2_map'"
      proof (rule UnE)
        assume "xs  a2"
        then show "xs  filter_a2_map I ts' tp' a2_map'"
          using a2_sub_filter by auto
      next
        assume "xs  join rel2 pos a1 - a2"
        then have xs_props: "xs  rel2" "xs  a2" "proj_tuple_in_join pos maskL xs a1"
          unfolding join_rel2_eq by auto
        have ts_tp_lt'_new_tstp: "ts_tp_lt' ts' tp' new_tstp"
          using tp'_lt_tp in_int t_nt eqs(1) unfolding new_tstp_def
          by (auto simp add: ts_tp_lt'_def)
        show "xs  filter_a2_map I ts' tp' a2_map'"
        proof (cases pos)
          case True
          then obtain tp''' where tp'''_def: "tp'''  tp'"
            "Mapping.lookup a1_map (proj_tuple maskL xs) = Some tp'''"
            using eqs(2)[unfolded filter_a1_map_def] xs_props(3)[unfolded proj_tuple_in_join_def]
            by (auto dest: Mapping_keys_dest)
          define wtp where "wtp  max (tp - len) tp'''"
          have wtp_xs_in: "(wtp, xs)  tmp"
            unfolding wtp_def using tp'''_def tmp_def xs_props(1) True by fastforce
          have wtp_le: "wtp  tp'"
            using tp'''_def(1) tp'_ge unfolding wtp_def by auto
          have wtp_in: "wtp  {tp - len..tp}"
            using tp'''_def(1) tp'_lt_tp unfolding wtp_def by auto
          have wtp_neq: "tp + 1  wtp"
            using wtp_in by auto
          obtain m where m_def: "Mapping.lookup a2_map wtp = Some m"
            using wtp_in a2_map_keys Mapping_keys_dest by fastforce
          obtain m' where m'_def: "Mapping.lookup a2_map' wtp = Some m'"
            using wtp_in a2_map'_keys Mapping_keys_dest by fastforce
          have m'_alt: "m' = upd_set' m new_tstp (max_tstp new_tstp) {b. (wtp, b)  tmp}"
            using m'_def[unfolded a2_map'_def Mapping.lookup_update_neq[OF wtp_neq]
              upd_nested_lookup m_def] by auto
          show ?thesis
          proof (cases "Mapping.lookup m xs")
            case None
            have "Mapping.lookup m' xs = Some new_tstp"
              using wtp_xs_in unfolding m'_alt upd_set'_lookup None by auto
            then show ?thesis
              unfolding filter_a2_map_def using wtp_le m'_def ts_tp_lt'_new_tstp by auto
          next
            case (Some tstp')
            have "Mapping.lookup m' xs = Some (max_tstp new_tstp tstp')"
              using wtp_xs_in unfolding m'_alt upd_set'_lookup Some by auto
            moreover have "ts_tp_lt' ts' tp' (max_tstp new_tstp tstp')"
              using max_tstp_intro''' ts_tp_lt'_new_tstp lookup_a2_map'[OF m_def Some] new_tstp_lt_isl
              by auto
            ultimately show ?thesis
              using lookup_a2_map'[OF m_def Some] wtp_le m'_def
              unfolding filter_a2_map_def by auto
          qed
        next
          case False
          show ?thesis
          proof (cases "Mapping.lookup a1_map (proj_tuple maskL xs)")
            case None
            then have in_tmp: "(tp - len, xs)  tmp"
              using tmp_def False xs_props(1) by fastforce
            obtain m where m_def: "Mapping.lookup a2_map (tp - len) = Some m"
              using a2_map_keys by (fastforce dest: Mapping_keys_dest)
            obtain m' where m'_def: "Mapping.lookup a2_map' (tp - len) = Some m'"
              using a2_map'_keys by (fastforce dest: Mapping_keys_dest)
            have tp_neq: "tp + 1  tp - len"
              by auto
            have m'_alt: "m' = upd_set' m new_tstp (max_tstp new_tstp) {b. (tp - len, b)  tmp}"
              using m'_def[unfolded a2_map'_def Mapping.lookup_update_neq[OF tp_neq]
                upd_nested_lookup m_def] by auto
            show ?thesis
            proof (cases "Mapping.lookup m xs")
              case None
              have "Mapping.lookup m' xs = Some new_tstp"
                unfolding m'_alt upd_set'_lookup None using in_tmp by auto
              then show ?thesis
                unfolding filter_a2_map_def using tp'_ge m'_def ts_tp_lt'_new_tstp by auto
            next
              case (Some tstp')
              have "Mapping.lookup m' xs = Some (max_tstp new_tstp tstp')"
                unfolding m'_alt upd_set'_lookup Some using in_tmp by auto
              moreover have "ts_tp_lt' ts' tp' (max_tstp new_tstp tstp')"
                using max_tstp_intro''' ts_tp_lt'_new_tstp lookup_a2_map'[OF m_def Some] new_tstp_lt_isl
                by auto
              ultimately show ?thesis
                unfolding filter_a2_map_def using tp'_ge m'_def by auto
            qed
          next
            case (Some tp''')
            then have tp'_gt: "tp' > tp'''"
              using xs_props(3)[unfolded proj_tuple_in_join_def] eqs(2)[unfolded filter_a1_map_def]
                False by (auto intro: Mapping_keys_intro)
            define wtp where "wtp  max (tp - len) (tp''' + 1)"
            have wtp_xs_in: "(wtp, xs)  tmp"
              unfolding wtp_def tmp_def using xs_props(1) Some False by fastforce
            have wtp_le: "wtp  tp'"
              using tp'_ge tp'_gt unfolding wtp_def by auto
            have wtp_in: "wtp  {tp - len..tp}"
              using tp'_lt_tp tp'_gt unfolding wtp_def by auto
            have wtp_neq: "tp + 1  wtp"
              using wtp_in by auto
            obtain m where m_def: "Mapping.lookup a2_map wtp = Some m"
              using wtp_in a2_map_keys Mapping_keys_dest by fastforce
            obtain m' where m'_def: "Mapping.lookup a2_map' wtp = Some m'"
              using wtp_in a2_map'_keys Mapping_keys_dest by fastforce
            have m'_alt: "m' = upd_set' m new_tstp (max_tstp new_tstp) {b. (wtp, b)  tmp}"
              using m'_def[unfolded a2_map'_def Mapping.lookup_update_neq[OF wtp_neq]
                upd_nested_lookup m_def] by auto
            show ?thesis
            proof (cases "Mapping.lookup m xs")
              case None
              have "Mapping.lookup m' xs = Some new_tstp"
                using wtp_xs_in unfolding m'_alt upd_set'_lookup None by auto
              then show ?thesis
                unfolding filter_a2_map_def using wtp_le m'_def ts_tp_lt'_new_tstp by auto
            next
              case (Some tstp')
              have "Mapping.lookup m' xs = Some (max_tstp new_tstp tstp')"
                using wtp_xs_in unfolding m'_alt upd_set'_lookup Some by auto
              moreover have "ts_tp_lt' ts' tp' (max_tstp new_tstp tstp')"
                using max_tstp_intro''' ts_tp_lt'_new_tstp lookup_a2_map'[OF m_def Some] new_tstp_lt_isl
                by auto
              ultimately show ?thesis
                using lookup_a2_map'[OF m_def Some] wtp_le m'_def
                unfolding filter_a2_map_def by auto
            qed
          qed
        qed
      qed
    qed
    moreover have "nt - t < left I  filter_a2_map I ts' tp' a2_map' = a2"
    proof (rule set_eqI, rule iffI)
      fix xs
      assume out: "nt - t < left I"
      assume xs_in: "xs  filter_a2_map I ts' tp' a2_map'"
      then obtain m' tp'' tstp where m'_def: "tp''  tp'" "Mapping.lookup a2_map' tp'' = Some m'"
        "Mapping.lookup m' xs = Some tstp" "ts_tp_lt' ts' tp' tstp"
        unfolding filter_a2_map_def by (fastforce split: option.splits)
      have new_tstp_False: "tstp = new_tstp  False"
        using m'_def t_nt out tp'_lt_tp unfolding eqs(1)
        by (auto simp add: ts_tp_lt'_def new_tstp_def)
      show "xs  a2"
        using filter_sub_a2[OF m'_def new_tstp_False xs_in] .
    next
      fix xs
      assume "xs  a2"
      then show "xs  filter_a2_map I ts' tp' a2_map'"
        using a2_sub_filter by auto
    qed
    ultimately show "triple_eq_pair (case tri of (t, a1, a2) 
      (t, if pos then join a1 True rel1 else a1  rel1,
      if left I  nt - t then a2  join rel2 pos a1 else a2))
      pair (λtp'. filter_a1_map pos tp' a1_map') (λts' tp'. filter_a2_map I ts' tp' a2_map')"
      using eqs unfolding tri_def pair_def by auto
  qed
  have filter_a1_map_rel1: "filter_a1_map pos tp a1_map' = rel1"
    unfolding filter_a1_map_def a1_map'_def using leD lookup_a1_map_keys
    by (force simp add: a1_map_lookup less_imp_le_nat Mapping.lookup_filter
        Mapping_lookup_upd_set keys_is_none_rep dest: Mapping_keys_filterD
        intro: Mapping_keys_intro split: option.splits)
  have filter_a1_map_rel2: "filter_a2_map I nt tp a2_map' =
    (if left I = 0 then rel2 else empty_table)"
  proof (cases "left I = 0")
    case True
    note left_I_zero = True
    have "tp' m' xs tstp. tp'  tp  Mapping.lookup a2_map' tp' = Some m' 
      Mapping.lookup m' xs = Some tstp  ts_tp_lt' nt tp tstp  xs  rel2"
    proof -
      fix tp' m' xs tstp
      assume lassms: "tp'  tp" "Mapping.lookup a2_map' tp' = Some m'"
        "Mapping.lookup m' xs = Some tstp" "ts_tp_lt' nt tp tstp"
      have tp'_neq: "tp + 1  tp'"
        using lassms(1) by auto
      have tp'_in: "tp'  {tp - len..tp}"
        using lassms(1,2) a2_map'_keys tp'_neq by (auto intro!: Mapping_keys_intro)
      obtain m where m_def: "Mapping.lookup a2_map tp' = Some m"
        "m' = upd_set' m new_tstp (max_tstp new_tstp) {b. (tp', b)  tmp}"
        using lassms(2)[unfolded a2_map'_def Mapping.lookup_update_neq[OF tp'_neq]
          upd_nested_lookup] tp'_in a2_map_keys
        by (fastforce dest: Mapping_keys_dest intro: Mapping_keys_intro split: option.splits)
      have "xs  {b. (tp', b)  tmp}"
      proof (rule ccontr)
        assume "xs  {b. (tp', b)  tmp}"
        then have Some: "Mapping.lookup m xs = Some tstp"
          using lassms(3)[unfolded m_def(2) upd_set'_lookup] by auto
        show "False"
          using lookup_a2_map'[OF m_def(1) Some] lassms(4)
          by (auto simp add: tstp_lt_def ts_tp_lt'_def split: sum.splits)
      qed
      then show "xs  rel2"
        unfolding tmp_def by (auto split: option.splits if_splits)
    qed
    moreover have "xs. xs  rel2  m' tstp. Mapping.lookup a2_map' tp = Some m' 
      Mapping.lookup m' xs = Some tstp  ts_tp_lt' nt tp tstp"
    proof -
      fix xs
      assume lassms: "xs  rel2"
      obtain m' where m'_def: "Mapping.lookup a2_map' tp = Some m'"
        using a2_map'_keys by (fastforce dest: Mapping_keys_dest)
      have tp_neq: "tp + 1  tp"
        by auto
      obtain m where m_def: "Mapping.lookup a2_map tp = Some m"
        "m' = upd_set' m new_tstp (max_tstp new_tstp) {b. (tp, b)  tmp}"
        using m'_def a2_map_keys unfolding a2_map'_def Mapping.lookup_update_neq[OF tp_neq]
          upd_nested_lookup
        by (auto dest: Mapping_keys_dest split: option.splits if_splits)
           (metis Mapping_keys_dest atLeastAtMost_iff diff_le_self le_eq_less_or_eq
            option.simps(3))
      have xs_in_tmp: "xs  {b. (tp, b)  tmp}"
        using lassms left_I_zero unfolding tmp_def by auto
      show "m' tstp. Mapping.lookup a2_map' tp = Some m' 
        Mapping.lookup m' xs = Some tstp  ts_tp_lt' nt tp tstp"
      proof (cases "Mapping.lookup m xs")
        case None
        moreover have "Mapping.lookup m' xs = Some new_tstp"
          using xs_in_tmp unfolding m_def(2) upd_set'_lookup None by auto
        moreover have "ts_tp_lt' nt tp new_tstp"
          using left_I_zero new_tstp_def by (auto simp add: ts_tp_lt'_def)
        ultimately show ?thesis
          using xs_in_tmp m_def
          unfolding a2_map'_def Mapping.lookup_update_neq[OF tp_neq] upd_nested_lookup by auto
      next
        case (Some tstp')
        moreover have "Mapping.lookup m' xs = Some (max_tstp new_tstp tstp')"
          using xs_in_tmp unfolding m_def(2) upd_set'_lookup Some by auto
        moreover have "ts_tp_lt' nt tp (max_tstp new_tstp tstp')"
          using max_tstpE[of new_tstp tstp'] lookup_a2_map'[OF m_def(1) Some] new_tstp_lt_isl left_I_zero
          by (auto simp add: sum.discI(1) new_tstp_def ts_tp_lt'_def tstp_lt_def split: sum.splits)
        ultimately show ?thesis
          using xs_in_tmp m_def
          unfolding a2_map'_def Mapping.lookup_update_neq[OF tp_neq] upd_nested_lookup by auto
      qed
    qed
    ultimately show ?thesis
      using True by (fastforce simp add: filter_a2_map_def split: option.splits)
  next
    case False
    note left_I_pos = False
    have "tp' m xs tstp. tp'  tp  Mapping.lookup a2_map' tp' = Some m 
      Mapping.lookup m xs = Some tstp  ¬(ts_tp_lt' nt tp tstp)"
    proof -
      fix tp' m' xs tstp
      assume lassms: "tp'  tp" "Mapping.lookup a2_map' tp' = Some m'"
        "Mapping.lookup m' xs = Some tstp"
      from lassms(1) have tp'_neq_Suc_tp: "tp + 1  tp'"
        by auto
      show "¬(ts_tp_lt' nt tp tstp)"
      proof (cases "Mapping.lookup a2_map tp'")
        case None
        then have tp'_in_tmp: "tp'  fst ` tmp" and
          m'_alt: "m' = upd_set' Mapping.empty new_tstp (max_tstp new_tstp) {b. (tp', b)  tmp}"
          using lassms(2) unfolding a2_map'_def Mapping.lookup_update_neq[OF tp'_neq_Suc_tp]
            upd_nested_lookup by (auto split: if_splits)
        then have "tstp = new_tstp"
          using lassms(3)[unfolded m'_alt upd_set'_lookup]
          by (auto simp add: Mapping.lookup_empty split: if_splits)
        then show ?thesis
          using False by (auto simp add: ts_tp_lt'_def new_tstp_def split: if_splits sum.splits)
      next
        case (Some m)
        then have m'_alt: "m' = upd_set' m new_tstp (max_tstp new_tstp) {b. (tp', b)  tmp}"
          using lassms(2) unfolding a2_map'_def Mapping.lookup_update_neq[OF tp'_neq_Suc_tp]
            upd_nested_lookup by auto
        note lookup_a2_map_tp' = Some
        show ?thesis
        proof (cases "Mapping.lookup m xs")
          case None
          then have "tstp = new_tstp"
            using lassms(3) unfolding m'_alt upd_set'_lookup by (auto split: if_splits)
          then show ?thesis
            using False by (auto simp add: ts_tp_lt'_def new_tstp_def split: if_splits sum.splits)
        next
          case (Some tstp')
          show ?thesis
          proof (cases "xs  {b. (tp', b)  tmp}")
            case True
            then have tstp_eq: "tstp = max_tstp new_tstp tstp'"
              using lassms(3)
              unfolding m'_alt upd_set'_lookup Some by auto
            show ?thesis
              using max_tstpE[of new_tstp tstp'] lookup_a2_map'[OF lookup_a2_map_tp' Some] new_tstp_lt_isl left_I_pos
              by (auto simp add: tstp_eq tstp_lt_def ts_tp_lt'_def split: sum.splits)
          next
            case False
            then show ?thesis
              using lassms(3) lookup_a2_map'[OF lookup_a2_map_tp' Some]
              unfolding m'_alt upd_set'_lookup Some
              by (auto simp add: ts_tp_lt'_def tstp_lt_def split: sum.splits)
          qed
        qed
      qed
    qed
    then show ?thesis
      using False by (auto simp add: filter_a2_map_def empty_table_def split: option.splits)
  qed
  have zip_dist: "zip (linearize tss @ [nt]) ([tp - len..<tp] @ [tp]) =
    zip (linearize tss) [tp - len..<tp] @ [(nt, tp)]"
    using valid_shift_aux(1) by auto
  have list_all2': "list_all2 (λx y. triple_eq_pair x y (λtp'. filter_a1_map pos tp' a1_map')
    (λts' tp'. filter_a2_map I ts' tp' a2_map'))
    (drop (length done) (update_until args rel1 rel2 nt auxlist))
    (zip (linearize tss') [tp + 1 - (len + 1)..<tp + 1])"
    unfolding lin_tss' tp_upt_Suc drop_update_until zip_dist
    using filter_a1_map_rel1 filter_a1_map_rel2 list_all2_appendI[OF list_all2_old]
    by auto
  show ?thesis
    using valid_shift_aux len_lin_tss' sorted_lin_tss' set_lin_tss' tab_a1_map'_keys a2_map'_keys'
      len_upd_until sorted_upd_until lookup_a1_map_keys' rev_done' set_take_auxlist'
      lookup_a2_map'_keys list_all2'
    unfolding valid_mmuaux_def add_new_mmuaux_eq valid_mmuaux'.simps
      I_def n_def L_def R_def pos_def by auto
qed

lemma list_all2_check_before: "list_all2 (λx y. triple_eq_pair x y f g) xs (zip ys zs) 
  (y. y  set ys  ¬enat y + right I < nt)  x  set xs  ¬check_before I nt x"
  by (auto simp: in_set_zip elim!: list_all2_in_setE triple_eq_pair.elims)

fun eval_mmuaux :: "args  ts  'a mmuaux  'a table list × 'a mmuaux" where
  "eval_mmuaux args nt aux =
    (let (tp, tss, len, maskL, maskR, a1_map, a2_map, done, done_length) =
    shift_mmuaux args nt aux in
    (rev done, (tp, tss, len, maskL, maskR, a1_map, a2_map, [], 0)))"

lemma valid_eval_mmuaux:
  assumes "valid_mmuaux args cur aux auxlist" "nt  cur"
    "eval_mmuaux args nt aux = (res, aux')" "eval_until (args_ivl args) nt auxlist = (res', auxlist')"
  shows "res = res'  valid_mmuaux args cur aux' auxlist'"
proof -
  define I where "I = args_ivl args"
  define pos where "pos = args_pos args"
  have valid_folded: "valid_mmuaux' args cur nt aux auxlist"
    using assms(1,2) valid_mmuaux'_mono unfolding valid_mmuaux_def by blast
  obtain tp len tss maskL maskR a1_map a2_map "done" done_length where shift_aux_def:
    "shift_mmuaux args nt aux = (tp, tss, len, maskL, maskR, a1_map, a2_map, done, done_length)"
    by (cases "shift_mmuaux args nt aux") auto
  have valid_shift_aux: "valid_mmuaux' args cur nt (tp, tss, len, maskL, maskR,
    a1_map, a2_map, done, done_length) auxlist"
    "ts. ts  set (linearize tss)  ¬enat ts + right (args_ivl args) < enat nt"
    using valid_shift_mmuaux'[OF assms(1)[unfolded valid_mmuaux_def] assms(2)]
    unfolding shift_aux_def by auto
  have len_done_auxlist: "length done  length auxlist"
    using valid_shift_aux by auto
  have list_all: "x. x  set (take (length done) auxlist)  check_before I nt x"
    using valid_shift_aux unfolding I_def by auto
  have set_drop_auxlist: "x. x  set (drop (length done) auxlist)  ¬check_before I nt x"
    using valid_shift_aux[unfolded valid_mmuaux'.simps]
      list_all2_check_before[OF _ valid_shift_aux(2)] unfolding I_def by fast
  have take_auxlist_takeWhile: "take (length done) auxlist = takeWhile (check_before I nt) auxlist"
    using len_done_auxlist list_all set_drop_auxlist
    by (rule take_takeWhile) assumption+
  have rev_done: "rev done = map proj_thd (take (length done) auxlist)"
    using valid_shift_aux by auto
  then have res'_def: "res' = rev done"
    using eval_until_res[OF assms(4)] unfolding take_auxlist_takeWhile I_def by auto
  then have auxlist'_def: "auxlist' = drop (length done) auxlist"
    using eval_until_auxlist'[OF assms(4)] by auto
  have eval_mmuaux_eq: "eval_mmuaux args nt aux = (rev done, (tp, tss, len, maskL, maskR,
    a1_map, a2_map, [], 0))"
    using shift_aux_def by auto
  show ?thesis
    using assms(3) done_empty_valid_mmuaux'_intro[OF valid_shift_aux(1)]
    unfolding shift_aux_def eval_mmuaux_eq pos_def auxlist'_def res'_def valid_mmuaux_def by auto
qed

definition init_mmuaux :: "args  'a mmuaux" where
  "init_mmuaux args = (0, empty_queue, 0,
  join_mask (args_n args) (args_L args), join_mask (args_n args) (args_R args),
  Mapping.empty, Mapping.update 0 Mapping.empty Mapping.empty, [], 0)"

lemma valid_init_mmuaux: "L  R  valid_mmuaux (init_args I n L R b) 0
  (init_mmuaux (init_args I n L R b)) []"
  unfolding init_mmuaux_def valid_mmuaux_def
  by (auto simp add: init_args_def empty_queue_rep table_def Mapping.lookup_update)

fun length_mmuaux :: "args  'a mmuaux  nat" where
  "length_mmuaux args (tp, tss, len, maskL, maskR, a1_map, a2_map, done, done_length) =
    len + done_length"

lemma valid_length_mmuaux:
  assumes "valid_mmuaux args cur aux auxlist"
  shows "length_mmuaux args aux = length auxlist"
  using assms by (cases aux) (auto simp add: valid_mmuaux_def dest: list_all2_lengthD)

(*<*)
end
(*>*)

Theory Monitor_Impl

(*<*)
theory Monitor_Impl
  imports Monitor
    Optimized_MTL
    "HOL-Library.Code_Target_Nat"
    Containers.Containers
begin
(*>*)

section ‹Instantiation of the generic algorithm and code setup›

lemma [code_unfold del, symmetric, code_post del]: "card  Cardinality.card'" by simp
declare [[code drop: card]] Set_Impl.card_code[code]

instantiation enat :: set_impl begin
definition set_impl_enat :: "(enat, set_impl) phantom" where
  "set_impl_enat = phantom set_RBT"

instance ..
end

derive ccompare Formula.trm
derive (eq) ceq Formula.trm
derive (rbt) set_impl Formula.trm
derive (eq) ceq Monitor.mregex
derive ccompare Monitor.mregex
derive (rbt) set_impl Monitor.mregex
derive (rbt) mapping_impl Monitor.mregex
derive (no) cenum Monitor.mregex
derive (rbt) set_impl event_data
derive (rbt) mapping_impl event_data

definition add_new_mmuaux' :: "args  event_data table  event_data table  ts  event_data mmuaux 
  event_data mmuaux" where
  "add_new_mmuaux' = add_new_mmuaux"

interpretation muaux valid_mmuaux init_mmuaux add_new_mmuaux' length_mmuaux eval_mmuaux
  using valid_init_mmuaux valid_add_new_mmuaux valid_length_mmuaux valid_eval_mmuaux
  unfolding add_new_mmuaux'_def
  by unfold_locales assumption+

type_synonym 'a vmsaux = "nat × (nat × 'a table) list"

definition valid_vmsaux :: "args  nat  event_data vmsaux 
  (nat × event_data table) list  bool" where
  "valid_vmsaux = (λ_ cur (t, aux) auxlist. t = cur  aux = auxlist)"

definition init_vmsaux :: "args  event_data vmsaux" where
  "init_vmsaux = (λ_. (0, []))"

definition add_new_ts_vmsaux :: "args  nat  event_data vmsaux  event_data vmsaux" where
  "add_new_ts_vmsaux = (λargs nt (t, auxlist). (nt, filter (λ(t, rel).
    enat (nt - t)  right (args_ivl args)) auxlist))"

definition join_vmsaux :: "args  event_data table  event_data vmsaux  event_data vmsaux" where
  "join_vmsaux = (λargs rel1 (t, auxlist). (t, map (λ(t, rel).
    (t, join rel (args_pos args) rel1)) auxlist))"

definition add_new_table_vmsaux :: "args  event_data table  event_data vmsaux 
  event_data vmsaux" where
  "add_new_table_vmsaux = (λargs rel2 (cur, auxlist). (cur, (case auxlist of
    [] => [(cur, rel2)]
  | ((t, y) # ts)  if t = cur then (t, y  rel2) # ts else (cur, rel2) # auxlist)))"

definition result_vmsaux :: "args  event_data vmsaux  event_data table" where
  "result_vmsaux = (λargs (cur, auxlist).
    foldr (∪) [rel. (t, rel)  auxlist, left (args_ivl args)  cur - t] {})"

type_synonym 'a vmuaux = "nat × (nat × 'a table × 'a table) list"

definition valid_vmuaux :: "args  nat  event_data vmuaux 
  (nat × event_data table × event_data table) list  bool" where
  "valid_vmuaux = (λ_ cur (t, aux) auxlist. t = cur  aux = auxlist)"

definition init_vmuaux :: "args  event_data vmuaux" where
  "init_vmuaux = (λ_. (0, []))"

definition add_new_vmuaux ::  "args  event_data table  event_data table  nat 
  event_data vmuaux  event_data vmuaux" where
  "add_new_vmuaux = (λargs rel1 rel2 nt (t, auxlist). (nt, update_until args rel1 rel2 nt auxlist))"

definition length_vmuaux :: "args  event_data vmuaux  nat" where
  "length_vmuaux = (λ_ (_, auxlist). length auxlist)"

definition eval_vmuaux :: "args  nat  event_data vmuaux 
  event_data table list × event_data vmuaux" where
  "eval_vmuaux = (λargs nt (t, auxlist).
    (let (res, auxlist') = eval_until (args_ivl args) nt auxlist in (res, (t, auxlist'))))"

global_interpretation verimon_maux: maux valid_vmsaux init_vmsaux add_new_ts_vmsaux join_vmsaux
  add_new_table_vmsaux result_vmsaux valid_vmuaux init_vmuaux add_new_vmuaux length_vmuaux
  eval_vmuaux
  defines vminit0 = "maux.minit0 (init_vmsaux :: _  event_data vmsaux) (init_vmuaux :: _  event_data vmuaux) :: _  Formula.formula  _"
  and vminit = "maux.minit (init_vmsaux :: _  event_data vmsaux) (init_vmuaux :: _  event_data vmuaux) :: Formula.formula  _"
  and vminit_safe = "maux.minit_safe (init_vmsaux :: _  event_data vmsaux) (init_vmuaux :: _  event_data vmuaux) :: Formula.formula  _"
  and vmupdate_since = "maux.update_since add_new_ts_vmsaux join_vmsaux add_new_table_vmsaux (result_vmsaux :: _  event_data vmsaux  event_data table)"
  and vmeval = "maux.meval add_new_ts_vmsaux join_vmsaux add_new_table_vmsaux (result_vmsaux :: _  event_data vmsaux  _) add_new_vmuaux (eval_vmuaux :: _  _  event_data vmuaux  _)"
  and vmstep = "maux.mstep add_new_ts_vmsaux join_vmsaux add_new_table_vmsaux (result_vmsaux :: _  event_data vmsaux  _) add_new_vmuaux (eval_vmuaux :: _  _  event_data vmuaux  _)"
  and vmsteps0_stateless = "maux.msteps0_stateless add_new_ts_vmsaux join_vmsaux add_new_table_vmsaux (result_vmsaux :: _  event_data vmsaux  _) add_new_vmuaux (eval_vmuaux :: _  _  event_data vmuaux  _)"
  and vmsteps_stateless = "maux.msteps_stateless add_new_ts_vmsaux join_vmsaux add_new_table_vmsaux (result_vmsaux :: _  event_data vmsaux  _) add_new_vmuaux (eval_vmuaux :: _  _  event_data vmuaux  _)"
  and vmonitor = "maux.monitor init_vmsaux add_new_ts_vmsaux join_vmsaux add_new_table_vmsaux (result_vmsaux :: _  event_data vmsaux  _) init_vmuaux add_new_vmuaux (eval_vmuaux :: _  _  event_data vmuaux  _)"
  unfolding valid_vmsaux_def init_vmsaux_def add_new_ts_vmsaux_def join_vmsaux_def
    add_new_table_vmsaux_def result_vmsaux_def valid_vmuaux_def init_vmuaux_def add_new_vmuaux_def
    length_vmuaux_def eval_vmuaux_def
  by unfold_locales auto

global_interpretation default_maux: maux valid_mmsaux "init_mmsaux :: _  event_data mmsaux" add_new_ts_mmsaux gc_join_mmsaux add_new_table_mmsaux result_mmsaux
  valid_mmuaux "init_mmuaux :: _  event_data mmuaux" add_new_mmuaux' length_mmuaux eval_mmuaux
  defines minit0 = "maux.minit0 (init_mmsaux :: _  event_data mmsaux) (init_mmuaux :: _  event_data mmuaux) :: _  Formula.formula  _"
  and minit = "maux.minit (init_mmsaux :: _  event_data mmsaux) (init_mmuaux :: _  event_data mmuaux) :: Formula.formula  _"
  and minit_safe = "maux.minit_safe (init_mmsaux :: _  event_data mmsaux) (init_mmuaux :: _  event_data mmuaux) :: Formula.formula  _"
  and mupdate_since = "maux.update_since add_new_ts_mmsaux gc_join_mmsaux add_new_table_mmsaux (result_mmsaux :: _  event_data mmsaux  event_data table)"
  and meval = "maux.meval add_new_ts_mmsaux gc_join_mmsaux add_new_table_mmsaux (result_mmsaux :: _  event_data mmsaux  _) add_new_mmuaux' (eval_mmuaux :: _  _  event_data mmuaux  _)"
  and mstep = "maux.mstep add_new_ts_mmsaux gc_join_mmsaux add_new_table_mmsaux (result_mmsaux :: _  event_data mmsaux  _) add_new_mmuaux' (eval_mmuaux :: _  _  event_data mmuaux  _)"
  and msteps0_stateless = "maux.msteps0_stateless add_new_ts_mmsaux gc_join_mmsaux add_new_table_mmsaux (result_mmsaux :: _  event_data mmsaux  _) add_new_mmuaux' (eval_mmuaux :: _  _  event_data mmuaux  _)"
  and msteps_stateless = "maux.msteps_stateless add_new_ts_mmsaux gc_join_mmsaux add_new_table_mmsaux (result_mmsaux :: _  event_data mmsaux  _) add_new_mmuaux' (eval_mmuaux :: _  _  event_data mmuaux  _)"
  and monitor = "maux.monitor init_mmsaux add_new_ts_mmsaux gc_join_mmsaux add_new_table_mmsaux (result_mmsaux :: _  event_data mmsaux  _) init_mmuaux add_new_mmuaux' (eval_mmuaux :: _  _  event_data mmuaux  _)"
  by unfold_locales

lemma image_these: "f ` Option.these X = Option.these (map_option f ` X)"
  by (force simp: in_these_eq Bex_def image_iff map_option_case split: option.splits)

thm default_maux.meval.simps(2)

lemma meval_MPred: "meval n t db (MPred e ts) =
  (case Mapping.lookup db e of None  [{}] | Some Xs  map (λX. v  X.
  (set_option (map_option (λf. Table.tabulate f 0 n) (match ts v)))) Xs, MPred e ts)"
  by (force split: option.splits simp: Option.these_def image_iff)

lemmas meval_code[code] = default_maux.meval.simps(1) meval_MPred default_maux.meval.simps(3-)

definition mk_db :: "(Formula.name × event_data list set) list  _" where
  "mk_db t = Monitor.mk_db (n  set (map fst t). (λv. (n, v)) ` the (map_of t n))"

definition rbt_fold :: "_  event_data tuple set_rbt  _  _" where
  "rbt_fold = RBT_Set2.fold"

definition rbt_empty :: "event_data list set_rbt" where
  "rbt_empty = RBT_Set2.empty"

definition rbt_insert :: "_  _  event_data list set_rbt" where
  "rbt_insert = RBT_Set2.insert"

lemma saturate_commute:
  assumes "s. r  g s" "s. g (insert r s) = g s" "s. r  s  h s = g s"
  and terminates: "mono g" "X. X  C  g X  C" "finite C"
shows "saturate g {} = saturate h {r}"
proof (cases "g {} = {r}")
  case True
  with assms have "g {r} = {r}" "h {r} = {r}" by auto
  with True show ?thesis
    by (subst (1 2) saturate_code; subst saturate_code) (simp add: Let_def)
next
  case False
  then show ?thesis
    unfolding saturate_def while_def
    using while_option_finite_subset_Some[OF terminates] assms(1-3)
    by (subst while_option_commute_invariant[of "λS. S = {}  r  S" "λS. g S  S" g "λS. h S  S" "insert r" h "{}", symmetric])
      (auto 4 4 dest: while_option_stop[of "λS. g S  S" g "{}"])
qed

definition "RPDs_aux = saturate (λS. S   (RPD ` S))"

lemma RPDs_aux_code[code]:
  "RPDs_aux S = (let S' = S  Set.bind S RPD in if S'  S then S else RPDs_aux S')"
  unfolding RPDs_aux_def bind_UNION
  by (subst saturate_code) auto

declare RPDs_code[code del]
lemma RPDs_code[code]: "RPDs r = RPDs_aux {r}"
  unfolding RPDs_aux_def RPDs_code
  by (rule saturate_commute[where C="RPDs r"])
     (auto 0 3 simp: mono_def subset_singleton_iff RPDs_refl RPDs_trans finite_RPDs)

definition "LPDs_aux = saturate (λS. S   (LPD ` S))"

lemma LPDs_aux_code[code]:
  "LPDs_aux S = (let S' = S  Set.bind S LPD in if S'  S then S else LPDs_aux S')"
  unfolding LPDs_aux_def bind_UNION
  by (subst saturate_code) auto

declare LPDs_code[code del]
lemma LPDs_code[code]: "LPDs r = LPDs_aux {r}"
  unfolding LPDs_aux_def LPDs_code
  by (rule saturate_commute[where C="LPDs r"])
     (auto 0 3 simp: mono_def subset_singleton_iff LPDs_refl LPDs_trans finite_LPDs)

lemma is_empty_table_unfold [code_unfold]:
  "X = empty_table  Set.is_empty X"
  "empty_table = X  Set.is_empty X"
  "Cardinality.eq_set X empty_table  Set.is_empty X"
  "Cardinality.eq_set empty_table X  Set.is_empty X"
  "set_eq X empty_table  Set.is_empty X"
  "set_eq empty_table X  Set.is_empty X"
  "X = (set_empty impl)  Set.is_empty X"
  "(set_empty impl) = X  Set.is_empty X"
  "Cardinality.eq_set X (set_empty impl)  Set.is_empty X"
  "Cardinality.eq_set (set_empty impl) X  Set.is_empty X"
  "set_eq X (set_empty impl)  Set.is_empty X"
  "set_eq (set_empty impl) X  Set.is_empty X"
  unfolding set_eq_def set_empty_def empty_table_def Set.is_empty_def Cardinality.eq_set_def by auto

lemma tabulate_rbt_code[code]: "Monitor.mrtabulate (xs :: mregex list) f =
  (case ID CCOMPARE(mregex) of None  Code.abort (STR ''tabulate RBT_Mapping: ccompare = None'') (λ_. Monitor.mrtabulate (xs :: mregex list) f)
  | _  RBT_Mapping (RBT_Mapping2.bulkload (List.map_filter (λk. let fk = f k in if fk = empty_table then None else Some (k, fk)) xs)))"
  unfolding mrtabulate.abs_eq RBT_Mapping_def
  by (auto split: option.splits)

lemma combine_Mapping[code]:
  fixes t :: "('a :: ccompare, 'b) mapping_rbt" shows
  "Mapping.combine f (RBT_Mapping t) (RBT_Mapping u) = 
  (case ID CCOMPARE('a) of None  Code.abort (STR ''combine RBT_Mapping: ccompare = None'') (λ_. Mapping.combine f (RBT_Mapping t) (RBT_Mapping u))
                     | Some _  RBT_Mapping (RBT_Mapping2.join (λ_. f) t u))"
  by (auto simp add: Mapping.combine.abs_eq Mapping_inject lookup_join split: option.split)

lemma upd_set_empty[simp]: "upd_set m f {} = m"
  by transfer auto

lemma upd_set_insert[simp]: "upd_set m f (insert x A) = Mapping.update x (f x) (upd_set m f A)"
  by (rule mapping_eqI) (auto simp: Mapping_lookup_upd_set Mapping.lookup_update')

lemma upd_set_fold:
  assumes "finite A"
  shows "upd_set m f A = Finite_Set.fold (λa. Mapping.update a (f a)) m A"
proof -
  interpret comp_fun_idem "λa. Mapping.update a (f a)"
    by unfold_locales (transfer; auto simp: fun_eq_iff)+
  from assms show ?thesis
    by (induct A arbitrary: m rule: finite.induct) auto
qed

lift_definition upd_cfi :: "('a  'b)  ('a, ('a, 'b) mapping) comp_fun_idem"
  is "λf a m. Mapping.update a (f a) m"
  by unfold_locales (transfer; auto simp: fun_eq_iff)+

lemma upd_set_code[code]:
  "upd_set m f A = (if finite A then set_fold_cfi (upd_cfi f) m A else Code.abort (STR ''upd_set: infinite'') (λ_. upd_set m f A))"
  by (transfer fixing: m) (auto simp: upd_set_fold)

lemma lexordp_eq_code[code]: "lexordp_eq xs ys  (case xs of []  True
  | x # xs  (case ys of []  False
    | y # ys  if x < y then True else if x > y then False else lexordp_eq xs ys))"
  by (subst lexordp_eq.simps) (auto split: list.split)

definition "filter_set m X t = Mapping.filter (filter_cond X m t) m"

declare [[code drop: shift_end]]
declare shift_end.simps[folded filter_set_def, code]

lemma upd_set'_empty[simp]: "upd_set' m d f {} = m"
  by (rule mapping_eqI) (auto simp add: upd_set'_lookup)

lemma upd_set'_insert: "d = f d  (x. f (f x) = f x)  upd_set' m d f (insert x A) =
  (let m' = (upd_set' m d f A) in case Mapping.lookup m' x of None  Mapping.update x d m'
  | Some v  Mapping.update x (f v) m')"
  by (rule mapping_eqI) (auto simp: upd_set'_lookup Mapping.lookup_update' split: option.splits)

lemma upd_set'_aux1: "upd_set' Mapping.empty d f {b. b = k  (a, b)  A} =
  Mapping.update k d (upd_set' Mapping.empty d f {b. (a, b)  A})"
  by (rule mapping_eqI) (auto simp add: Let_def upd_set'_lookup Mapping.lookup_update'
      Mapping.lookup_empty split: option.splits)

lemma upd_set'_aux2: "Mapping.lookup m k = None  upd_set' m d f {b. b = k  (a, b)  A} =
  Mapping.update k d (upd_set' m d f {b. (a, b)  A})"
  by (rule mapping_eqI) (auto simp add: upd_set'_lookup Mapping.lookup_update' split: option.splits)

lemma upd_set'_aux3: "Mapping.lookup m k = Some v  upd_set' m d f {b. b = k  (a, b)  A} =
  Mapping.update k (f v) (upd_set' m d f {b. (a, b)  A})"
  by (rule mapping_eqI) (auto simp add: upd_set'_lookup Mapping.lookup_update' split: option.splits)

lemma upd_set'_aux4: "k  fst ` A  upd_set' Mapping.empty d f {b. (k, b)  A} = Mapping.empty"
  by (rule mapping_eqI) (auto simp add: upd_set'_lookup Mapping.lookup_update' Domain.DomainI fst_eq_Domain
      split: option.splits)

lemma upd_nested_empty[simp]: "upd_nested m d f {} = m"
  by (rule mapping_eqI) (auto simp add: upd_nested_lookup split: option.splits)

definition upd_nested_step :: "'c  ('c  'c)  'a × 'b  ('a, ('b, 'c) mapping) mapping 
  ('a, ('b, 'c) mapping) mapping" where
  "upd_nested_step d f x m = (case x of (k, k') 
    (case Mapping.lookup m k of Some m' 
      (case Mapping.lookup m' k' of Some v  Mapping.update k (Mapping.update k' (f v) m') m
      | None  Mapping.update k (Mapping.update k' d m') m)
    | None  Mapping.update k (Mapping.update k' d Mapping.empty) m))"

lemma upd_nested_insert:
  "d = f d  (x. f (f x) = f x)  upd_nested m d f (insert x A) =
  upd_nested_step d f x (upd_nested m d f A)"
  unfolding upd_nested_step_def
  using upd_set'_aux1[of d f _ _ A] upd_set'_aux2[of _ _ d f _ A] upd_set'_aux3[of _ _ _ d f _ A]
    upd_set'_aux4[of _ A d f]
  by (auto simp add: Let_def upd_nested_lookup upd_set'_lookup Mapping.lookup_update'
      Mapping.lookup_empty split: option.splits prod.splits if_splits intro!: mapping_eqI)

definition upd_nested_max_tstp where
  "upd_nested_max_tstp m d X = upd_nested m d (max_tstp d) X"

lemma upd_nested_max_tstp_fold:
  assumes "finite X"
  shows "upd_nested_max_tstp m d X = Finite_Set.fold (upd_nested_step d (max_tstp d)) m X"
proof -
  interpret comp_fun_idem "upd_nested_step d (max_tstp d)"
    by (unfold_locales; rule ext)
      (auto simp add: comp_def upd_nested_step_def Mapping.lookup_update' Mapping.lookup_empty
       update_update max_tstp_d_d max_tstp_idem' split: option.splits)
  note upd_nested_insert' = upd_nested_insert[of d "max_tstp d",
    OF max_tstp_d_d[symmetric] max_tstp_idem']
  show ?thesis
    using assms
    by (induct X arbitrary: m rule: finite.induct)
       (auto simp add: upd_nested_max_tstp_def upd_nested_insert')
qed

lift_definition upd_nested_max_tstp_cfi ::
  "ts + tp  ('a × 'b, ('a, ('b, ts + tp) mapping) mapping) comp_fun_idem"
  is "λd. upd_nested_step d (max_tstp d)"
  by (unfold_locales; rule ext)
    (auto simp add: comp_def upd_nested_step_def Mapping.lookup_update' Mapping.lookup_empty
      update_update max_tstp_d_d max_tstp_idem' split: option.splits)

lemma upd_nested_max_tstp_code[code]:
  "upd_nested_max_tstp m d X = (if finite X then set_fold_cfi (upd_nested_max_tstp_cfi d) m X
    else Code.abort (STR ''upd_nested_max_tstp: infinite'') (λ_. upd_nested_max_tstp m d X))"
  by transfer (auto simp add: upd_nested_max_tstp_fold)

declare [[code drop: add_new_mmuaux']]
declare add_new_mmuaux'_def[unfolded add_new_mmuaux.simps, folded upd_nested_max_tstp_def, code]

lemma filter_set_empty[simp]: "filter_set m {} t = m"
  unfolding filter_set_def
  by transfer (auto simp: fun_eq_iff split: option.splits)

lemma filter_set_insert[simp]: "filter_set m (insert x A) t = (let m' = filter_set m A t in
  case Mapping.lookup m' x of Some u  if t = u then Mapping.delete x m' else m' | _  m')"
  unfolding filter_set_def
  by transfer (auto simp: fun_eq_iff Let_def Map_To_Mapping.map_apply_def split: option.splits)

lemma filter_set_fold:
  assumes "finite A"
  shows "filter_set m A t = Finite_Set.fold (λa m.
    case Mapping.lookup m a of Some u  if t = u then Mapping.delete a m else m | _  m) m A"
proof -
  interpret comp_fun_idem "λa m.
    case Mapping.lookup m a of Some u  if t = u then Mapping.delete a m else m | _  m"
    by unfold_locales
      (transfer; auto simp: fun_eq_iff Map_To_Mapping.map_apply_def split: option.splits)+
  from assms show ?thesis
    by (induct A arbitrary: m rule: finite.induct) (auto simp: Let_def)
qed

lift_definition filter_cfi :: "'b  ('a, ('a, 'b) mapping) comp_fun_idem"
  is "λt a m.
    case Mapping.lookup m a of Some u  if t = u then Mapping.delete a m else m | _  m"
  by unfold_locales
    (transfer; auto simp: fun_eq_iff Map_To_Mapping.map_apply_def split: option.splits)+

lemma filter_set_code[code]:
  "filter_set m A t = (if finite A then set_fold_cfi (filter_cfi t) m A else Code.abort (STR ''upd_set: infinite'') (λ_. filter_set m A t))"
  by (transfer fixing: m) (auto simp: filter_set_fold)

lemma filter_Mapping[code]:
  fixes t :: "('a :: ccompare, 'b) mapping_rbt" shows
  "Mapping.filter P (RBT_Mapping t) = 
  (case ID CCOMPARE('a) of None  Code.abort (STR ''filter RBT_Mapping: ccompare = None'') (λ_. Mapping.filter P (RBT_Mapping t))
                     | Some _  RBT_Mapping (RBT_Mapping2.filter (case_prod P) t))"
  by (auto simp add: Mapping.filter.abs_eq Mapping_inject split: option.split)

definition "filter_join pos X m = Mapping.filter (join_filter_cond pos X) m"

declare [[code drop: join_mmsaux]]
declare join_mmsaux.simps[folded filter_join_def, code]

lemma filter_join_False_empty: "filter_join False {} m = m"
  unfolding filter_join_def
  by transfer (auto split: option.splits)

lemma filter_join_False_insert: "filter_join False (insert a A) m =
  filter_join False A (Mapping.delete a m)"
proof -
  {
    fix x
    have "Mapping.lookup (filter_join False (insert a A) m) x =
      Mapping.lookup (filter_join False A (Mapping.delete a m)) x"
      by (auto simp add: filter_join_def Mapping.lookup_filter Mapping_lookup_delete
          split: option.splits)
  }
  then show ?thesis
    by (simp add: mapping_eqI)
qed

lemma filter_join_False:
  assumes "finite A"
  shows "filter_join False A m = Finite_Set.fold Mapping.delete m A"
proof -
  interpret comp_fun_idem "Mapping.delete"
    by (unfold_locales; transfer) (fastforce simp add: comp_def)+
  from assms show ?thesis
    by (induction A arbitrary: m rule: finite.induct)
       (auto simp add: filter_join_False_empty filter_join_False_insert fold_fun_left_comm)
qed

lift_definition filter_not_in_cfi :: "('a, ('a, 'b) mapping) comp_fun_idem" is "Mapping.delete"
  by (unfold_locales; transfer) (fastforce simp add: comp_def)+

lemma filter_join_code[code]:
  "filter_join pos A m =
    (if ¬pos  finite A  card A < Mapping.size m then set_fold_cfi filter_not_in_cfi m A
    else Mapping.filter (join_filter_cond pos A) m)"
  unfolding filter_join_def
  by (transfer fixing: m) (use filter_join_False in auto simp add: filter_join_def›)

definition set_minus :: "'a set  'a set  'a set" where
  "set_minus X Y = X - Y"

lift_definition remove_cfi :: "('a, 'a set) comp_fun_idem"
  is "λb a. a - {b}"
  by unfold_locales auto

lemma set_minus_finite:
  assumes fin: "finite Y"
  shows "set_minus X Y = Finite_Set.fold (λa X. X - {a}) X Y"
proof -
  interpret comp_fun_idem "λa X. X - {a}"
    by unfold_locales auto
  from assms show ?thesis
    by (induction Y arbitrary: X rule: finite.induct) (auto simp add: set_minus_def)
qed

lemma set_minus_code[code]: "set_minus X Y =
  (if finite Y  card Y < card X then set_fold_cfi remove_cfi X Y else X - Y)"
  by transfer (use set_minus_finite in auto simp add: set_minus_def›)

declare [[code drop: bin_join]]
declare bin_join.simps[folded set_minus_def, code]

definition remove_Union where
  "remove_Union A X B = A - (x  X. B x)"

lemma remove_Union_finite: 
  assumes "finite X"
  shows "remove_Union A X B = Finite_Set.fold (λx A. A - B x) A X"
proof -
  interpret comp_fun_idem "λx A. A - B x"
    by unfold_locales auto
  from assms show ?thesis
    by (induct X arbitrary: A rule: finite_induct) (auto simp: remove_Union_def)
qed

lift_definition remove_Union_cfi :: "('a  'b set)  ('a, 'b set) comp_fun_idem" is "λB x A. A - B x"
  by unfold_locales auto

lemma remove_Union_code[code]: "remove_Union A X B =
  (if finite X then set_fold_cfi (remove_Union_cfi B) A X else A - (x  X. B x))"
  by (transfer fixing: A X B) (use remove_Union_finite[of X A B] in auto simp add: remove_Union_def›)

lemma tabulate_remdups: "Mapping.tabulate xs f = Mapping.tabulate (remdups xs) f"
  by (transfer fixing: xs f) (auto simp: map_of_map_restrict)

lift_definition clearjunk :: "(String.literal × event_data list set) list  (String.literal, event_data list set list) alist" is
  "λt. List.map_filter (λ(p, X). if X = {} then None else Some (p, [X])) (AList.clearjunk t)"
  unfolding map_filter_def o_def list.map_comp
  by (subst map_cong[OF refl, of _ _ fst]) (auto simp: map_filter_def distinct_map_fst_filter split: if_splits)

lemma map_filter_snd_map_filter: "List.map_filter (λ(a, b). if P b then None else Some (f a b)) xs =
    map (λ(a, b). f a b) (filter (λx. ¬ P (snd x)) xs)"
  by (simp add: map_filter_def prod.case_eq_if)

lemma mk_db_code_alist:
  "mk_db t = Assoc_List_Mapping (clearjunk t)"
  unfolding mk_db_def Assoc_List_Mapping_def
  by (transfer' fixing: t)
    (auto simp: map_filter_snd_map_filter fun_eq_iff map_of_map image_iff map_of_clearjunk
      map_of_filter_apply dest: weak_map_of_SomeI intro!: bexI[rotated, OF map_of_SomeD]
      split: if_splits option.splits)

lemma mk_db_code[code]:
  "mk_db t = Mapping.of_alist (List.map_filter (λ(p, X). if X = {} then None else Some (p, [X])) (AList.clearjunk t))"
  unfolding mk_db_def
  by (transfer' fixing: t) (auto simp: map_filter_snd_map_filter fun_eq_iff map_of_map image_iff
      map_of_clearjunk map_of_filter_apply dest: weak_map_of_SomeI intro!: bexI[rotated, OF map_of_SomeD]
      split: if_splits option.splits)

declare [[code drop: New_max_getIJ_genericJoin New_max_getIJ_wrapperGenericJoin]]
declare New_max.genericJoin.simps[folded remove_Union_def, code]
declare New_max.wrapperGenericJoin.simps[folded remove_Union_def, code]

(*<*)
end
(*>*)

Theory Monitor_Code

(*<*)
theory Monitor_Code
  imports Monitor_Impl
begin
(*>*)

export_code convert_multiway vminit_safe minit_safe vmstep mstep mmonitorable_exec
   checking OCaml?

export_code
  (*basic types*)
  nat_of_integer integer_of_nat int_of_integer integer_of_int enat
  interval mk_db RBT_set rbt_empty rbt_insert rbt_fold
  (*term, formula, and regex constructors*)
  EInt Formula.Var Formula.Agg_Cnt Formula.Pred Regex.Skip Regex.Wild
  (*main functions*)
  convert_multiway vminit_safe minit_safe vmstep mstep mmonitorable_exec
  in OCaml module_name Monitor file_prefix "verified"

(*<*)
end
(*>*)